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

image

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
Rechercher des sujets similaires à "simplifier classement medailles differencier hommes femmes"