Simplifier le classement des médailles sans différencier hommes & femmes
Bonjour,
J'aimerais rectifier les résultats de ma feuille "Pétanque Pts & Médailles" car je ne voudrais pas faire un classement qui différencie les hommes des femmes, uniquement sur la colonne "clt1".
Exemples :
Selon le tableau en "clt1" ci-dessous SAID ne serait plus première mais 3ème
RODRIGUES 4ème et non 2ème
Chez les garçons, les 3ème deviennent 6ème...
etc, etc, etc, et sur tous les résultats clt1 mais ne pas changer la méthode sur clt2 & clt3
Ca va simplifier le ""clt1" tout en gardant le fonctionnement actuel sur "clt2" et "clt3". Procédure en question, ci-dessous "Sub Medailles( )" mais je n'ose pas trop intervenir ==> Une idée ?
Pour débloquer les feuilles, le mdp c'est ==> seb
Tous le noms de familles sont une invention afin de protéger l'identité de mes vrais sportifs
Merci bcp de vous être intéressés à ce sujet
Bonne journée
Sub Medailles()
Dim Dict, i1, i2, i3, i4, sSexe, i As Integer, iOffset, Pts, N
Set Dict = CreateObject("scripting.dictionary")
iOffset = Range("tabel1").Row - 1
For i1 = 1 To 3
Select Case i1
Case 1
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT1]+ROW(Tabel1[CLT1])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_1]")
Case 2
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT2]+ROW(Tabel1[CLT2])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_2]")
Case 3
f_ = "MOD(IFERROR(AGGREGATE(15,6,(Tabel1[CLT3]+ROW(Tabel1[CLT3])/1000)/(Tabel1[Sexe]=#),@),0),1)*1000"
Set c = Range("tabel1[pts_3]")
End Select
For i2 = 1 To 2
sSexe = IIf(i2 = 1, "H", "F")
For i3 = 1 To 100
s = Replace(Replace(f_, "#", Chr(34) & sSexe & Chr(34)), "@", i3)
i4 = Evaluate(s)
If i4 = 0 Then Exit For
i = i4 - iOffset
Pts = c.Cells(i, 1).Value2
If Pts > 0 And Len(Pts) > 0 Then
'Debug.Print Pts
If Not Dict.exists(i) Then Dict(i) = Array(i4, Range("Tabel1[nom]").Cells(i, 1).Value2, Range("Tabel1[prenom]").Cells(i, 1).Value2, Range("Tabel1[sexe]").Cells(i, 1).Value2, Range("Tabel1[age]").Cells(i, 1).Value2, 0, 0, 0, 0)
'Debug.Print i, Range("Tabel1[nom]").Cells(i, 1).Value2, Range("Tabel1[prenom]").Cells(i, 1).Value2, Range("Tabel1[sexe]").Cells(i, 1).Value2, Range("Tabel1[age]").Cells(i, 1).Value2, 0, 0, 0, 0
itm = Dict(i)
itm(5) = Application.Max(Pts, itm(5)) 'itm(5) = Pts
If i1 = 1 Then itm(6) = Application.Max(Pts, itm(6))
If i1 = 2 Then itm(7) = Application.Max(Pts, itm(7)) 'itm(7) = IIf(i1 = 2, Pts, 0)
If i1 = 3 Then itm(8) = Application.Max(Pts, itm(8)) 'itm(8) = IIf(i1 = 3, Pts, 0)
Dict(i) = itm
End If
Next
Next
Next
N = Dict.Count
If N = 1 Then Dict.Add "dummy", Dict.items()(0)
b = Application.EnableEvents 'état des évenements (false ou true)
Application.EnableEvents = False 'désactiver
With Range("tabel6").ListObject
.Parent.Protect "seb", userinterfaceonly:=True 'enlever la protection pour la feuille pour VBA **********
If N = 0 And .ListRows.Count > 0 Then .DataBodyRange.Delete: Exit Sub
If .ListRows.Count = 0 Then .ListRows.Add
.DataBodyRange.Resize(Dict.Count, 9).Value = Application.Index(Dict.items, 0, 0)
If .ListRows.Count > N Then .DataBodyRange.Offset(N).Resize(.ListRows.Count - N).Delete
With .Range
.Sort .Cells(1, 4), xlAscending, , .Cells(1, 6), xlDescending, Header:=xlYes
End With
End With
Application.EnableEvents = b 'remettre dans l'état de 10 lignes plus haut
End Sub