Besoin d'aide pour faire du tri sur un fichier par VBA

[Yul80520]

Bonjour,

J'ai créé un fichier excel qui me permet de faire un classement automatique pour mon club de poker.

Je cherche à affiner le tri mais c'est un peu particulier.

Si quelqu'un veut bien me donner un coup de main, je suis preneur.

Je récupère les données qui m'intéressent dans les feuilles de résultats et je les colle dans une feuille nommée "Classement final", puis je trie en fonction du total de point de chacun. Je récupère également le classement de chaque journée ( 8 tournois pour cette saison )

Mon problème se situe au niveau du départage des ex æquo.
Je souhaite trier les joueurs en fonction de leur meilleure perf.

Le fichier est trop gros pour être posté sur le forum. Donc je mets la partie de la macro qui m'intéresse.
>>

'copier les noms dans la feuille de classement final

Sheets("TOTAL FINAL").Range("B2:B96").Copy
Sheets("Classement").Range("B2").PasteSpecial Paste:=xlPasteValues

'copier les colonnes de classement de chaque journée de classement final

Sheets("S2B1").Range("E8:E96").Copy
Sheets("Classement").Range("F2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B2").Range("E8:E96").Copy
Sheets("Classement").Range("G2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B3").Range("E8:E96").Copy
Sheets("Classement").Range("H2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B4").Range("E8:E96").Copy
Sheets("Classement").Range("I2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B5").Range("E8:E96").Copy
Sheets("Classement").Range("J2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B6").Range("E8:E96").Copy
Sheets("Classement").Range("K2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B7").Range("E8:E96").Copy
Sheets("Classement").Range("L2").PasteSpecial Paste:=xlPasteValues

Sheets("S2B8").Range("E8:E96").Copy
Sheets("Classement").Range("M2").PasteSpecial Paste:=xlPasteValues


'copier les résultats dans la feuille de classement final

Sheets("TOTAL FINAL").Range("L2:L96").Copy
Sheets("Classement").Range("C2:C96").PasteSpecial Paste:=xlPasteValues


'copier les points de bonus dans la feuille de classement final

Sheets("TOTAL FINAL").Range("K2:K96").Copy
Sheets("Classement").Range("E2:E96").PasteSpecial Paste:=xlPasteValues

'pour une matrice des lignes 2 à 112
'avec en colonne A un index des joueurs,
'en colonne B leur nom et
'en colonne C le rang que l'on va remplir automatiquement

'classer dans l'ordre alphabétique

Rows("2:96").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


'classer selon le score


Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


' Mettre 1 au rang du premier en donnant comme rang le N° de ligne moins 1

Range("D2").Select
ActiveCell.FormulaR1C1 = "=ROW(RC[-1])-1"

' Au suivant mettre son N° de ligne -1 s'il est différent du précédent,
'sinon mettre comme le précédent

Range("D3").Select
ActiveCell.FormulaR1C1 = "=+IF(RC[-1]=R[-1]C[-1],R[-1]C,ROW(RC[-1])-1)"

'copier cette formule dans toute lma colonne score de la matrice

Range("D3").Select
Selection.AutoFill Destination:=Range("D396"), Type:=xlFillDefault

'Copier la colonne des scores et la coller en valeur (collage spécial valeur)

Range("D296").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'retrier les lignes en fonction de l'index des joueurs mais ce pourrait être par ordre alphabétique par exemple

Rows("2:96").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("D3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("D3").Select

Range("D296").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("D296").Select
Selection.ClearContents

' supprimer les lignes entières ne comportant pas de Noms

Range("B2:B96").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

' supprimer les lignes entières ne comportant pas de Résultats


' supprimer La colonne "D"

Columns("D").Delete Shift:=xlToLeft
Range("D11").Select

<


A votre bon coeur, si vous arrivez à comprendre mes attentes.

Merci d'avance.

 

[GIBI]

Re : Besoin d'aide pour faire du tri sur un fichier par VBA

Bonsoir,

pour classer les joueur, en fonction du score, utiliser la fonction excel RANG
= rang(score;plage des scores;1)

dans le vba cela devrait être "=RANK(RC[-1],RC[-1]:R[96]C[-1],1)"

GIBI

 

[Yul80520]

Re : Besoin d'aide pour faire du tri sur un fichier par VBA

c'est pas le classement qui me gène mais le tri.

 

[Roland_M]

Re : Besoin d'aide pour faire du tri sur un fichier par VBA

bonjour

sans classeur pas possible !

par-contre tu peux raccourcir ton code ici !
'copier les colonnes de classement de chaque journée de classement final
For I = 1 To 8
RS$ = "S2B" & Trim(I)
RD$ = Choose(I, "F2", "G2", "H2", "I2", "J2", "K2", "L2", "M2")
Sheets(RS$).Range("E8:E96").Copy
Sheets("Classement").Range(RD$).PasteSpecial Paste:=xlPasteValues
Next

 

[GIBI]

Re : Besoin d'aide pour faire du tri sur un fichier par VBA

Bonjour,

Effectivement je n'avais pas compris le besoin, mais en relisant je propose une solution que tu pourras compléter.

L'idée est de considérer que le score comme une partie d'un nombre : le score finale = partie gauche + score max = partie droite

(Score * 10000)+ meilleur score si le score est 1254 et le meilleurs 1300 ==> 12541300

donc tu as une colonne avec =(Score*10000)+max(F*:M*) si score à 4 chiffres maxi

tu peux maintenant classer par rapport à cette colonne en utiliser la fonction excel RANG
(la fonction rang permet de faire un classement sans tri préalable)

Un peu brouillon ma solution, mais elle doit marcher

GIBI