Classement par categories

bonjour

je souhaiterais classer mon tableau "classement" en recherchant le meilleur de chaque catégories et les copier dans l'onglet récompenses

merci d'avance

en faisant attention au exequo

Bonjour

Un essai à tester. Te convient-il .?

Option Explicit

Dim tablo, tabloC, tablor, colR
Dim i&, j&, ln&, max&, cat$, nbL&

Sub Classement()

    tablo = Sheets("classement").Range("A1:J" & Sheets("classement").Range("A" & Rows.Count).End(xlUp).Row)
    tabloC = Sheets("classement").Range("N7").CurrentRegion
    ReDim tablor(1 To UBound(tablo, 1), 1 To UBound(tablo, 2))
    colR = Array(6, 2, 3, 4, 5, 7, 8, 9, 10)

    nbL = 0
    For i = 2 To UBound(tabloC, 1)
        max = 0
        For ln = 2 To UBound(tablo, 1)
            cat = tabloC(i, 1)
            If tablo(ln, 6) = cat Then
                If tablo(ln, 7) >= max Then
                    max = tablo(ln, 7)
                    For j = 0 To 8 '3 To UBound(tablor, 2)
                        tablor(nbL + 1, j + 2) = tablo(ln, colR(j))
                    Next j
                    tablor(nbL + 1, 1) = "meilleur" 'i
                    tablor(nbL + 1, 2) = tabloC(i, 2)
                    nbL = nbL + 1
                End If
            End If
        Next ln
    Next i

    Range("A3").CurrentRegion.Offset(1, 0).Clear
    Range("A3").Resize(nbL, UBound(tablor, 2)) = tablor
    Range("A3").Resize(nbL, UBound(tablor, 2)).Borders.LineStyle = xlContinuous

End Sub

Bye !

bonjour,

Merci oui c'est ce que je voulais !! ( juste je ne vois plus les colonne NOM et emplacement dans l'onglet classement)

j'aimerais avoir aussi :

-le meilleur jeune jusqu'à junior (homme et femme)

-la meilleure dame (toutes catégories)

-et le plus gros poisson

encore merci !

Nouvelle version

Option Explicit

Dim tablo, tabloC, tablor, colR
Dim i&, j&, derLn&, ln&, lnM1&, lnM2&, lnM3&, max&, max1&, max2&, max3&, cat$, nbL&

Sub Classement()

    tablo = Sheets("classement").Range("A1:J" & Sheets("classement").Range("A" & Rows.Count).End(xlUp).Row)
    tabloC = Sheets("classement").Range("N7").CurrentRegion
    ReDim tablor(1 To UBound(tablo, 1), 1 To UBound(tablo, 2))
    colR = Array(6, 2, 3, 4, 5, 7, 8, 9, 10)

    nbL = 0
    For i = 2 To UBound(tabloC, 1)
        max = 0
        For ln = 2 To UBound(tablo, 1)
            cat = tabloC(i, 1)
            If tablo(ln, 6) = cat Then
                If tablo(ln, 7) >= max Then
                    max = tablo(ln, 7)
                    For j = 0 To 8 '3 To UBound(tablor, 2)
                        tablor(nbL + 1, j + 2) = tablo(ln, colR(j))
                    Next j
                    tablor(nbL + 1, 1) = "meilleur" 'i
                    tablor(nbL + 1, 2) = tabloC(i, 2)
                    nbL = nbL + 1
                End If
            End If
        Next ln
    Next i

    Range("A3:J" & Range("A" & Rows.Count).End(xlUp).Row).Clear

    Range("A3").Resize(nbL, UBound(tablor, 2)) = tablor
    Range("A3").Resize(nbL, UBound(tablor, 2)).Borders.LineStyle = xlContinuous

    max1 = 0: max2 = 0: max3 = 0
    For ln = 2 To UBound(tablo, 1)
        If tablo(ln, 6) = "PD" Or tablo(ln, 6) = "B" Or tablo(ln, 6) = "BD" Or tablo(ln, 6) = "M" _
                Or tablo(ln, 6) = "MD" Or tablo(ln, 6) = "C" Or tablo(ln, 6) = "CD" Or tablo(ln, 6) = "J" _
                Or tablo(ln, 6) = "JD" Then
            If tablo(ln, 7) > max1 Then
                max1 = tablo(ln, 7)
                lnM1 = ln
            End If
        End If

        If tablo(ln, 6) = "PD" Or tablo(ln, 6) = "BD" Or tablo(ln, 6) = "MD" Or tablo(ln, 6) = "CD" _
                Or tablo(ln, 6) = "JD" Or tablo(ln, 6) = "SD" Or tablo(ln, 6) = "VD" Then
                        If tablo(ln, 7) > max2 Then
                max2 = tablo(ln, 7)
                lnM2 = ln
            End If
        End If

        If tablo(ln, 9) > max2 Then
                max3 = tablo(ln, 9)
                lnM3 = ln
        End If
    Next ln

    derLn = Range("B" & Rows.Count).End(xlUp)(3).Row
    Range("A" & derLn) = "meilleur jeune"
    Range("B" & derLn) = tablo(lnM1, 6)
    Range("C" & derLn) = tablo(lnM1, 2)
    Range("D" & derLn) = tablo(lnM1, 3)
    Range("G" & derLn) = tablo(lnM1, 7)

    Range("A" & derLn + 1) = "mùrommritr dame"
    Range("B" & derLn + 1) = tablo(lnM2, 6)
    Range("C" & derLn + 1) = tablo(lnM2, 2)
    Range("D" & derLn + 1) = tablo(lnM2, 3)
    Range("G" & derLn + 1) = tablo(lnM2, 7)

    Range("A" & derLn + 2) = "le plus gros poisson"
    Range("B" & derLn + 2) = tablo(lnM3, 6)
    Range("C" & derLn + 2) = tablo(lnM3, 2)
    Range("D" & derLn + 2) = tablo(lnM3, 3)
    Range("I" & derLn + 2) = tablo(lnM3, 9)

    Range("A" & derLn & ":J" & derLn + 2).Borders.LineStyle = xlContinuous
End Sub

Bye !

bonjour

très bien merci

-sur l'onglet récompense les entêtes du tableau n'apparaisse pas quand je clique sur classement

-sur les 3 dernières lignes toutes les cases ne se remplissent pas (n° de licence, club...)

-sur le plus gros poisson il y a une erreur il faut mettre le meilleur de la colonne I de l'onglet classement

-et j'ai oublié le meilleur toute catégories

encore merci d'avance

Bonjour

Nouvelle version.

Pour ce qui est du plus gros poisson, je n'en vois pas, dans l'exemple, de plus de 541 kg, pris dans la colonne i de "classement"

Bye !

en effet sur le fichier c'est le poisson le plus gros 541g

mais j'ai changé la valeur en (i2) 610 g et relancer la macro mais il garde le meilleur a 541g.

ensuite je voudrai aussi le premier toutes catégories (colonne G) à la suite du plus gros poissons

merci beaucoup !!

et es ce que la mise en forme peut aussi se faire automatiquement ?

Bonjour

Nouvelle version.

Bye !

C'est parfait un grand Merci !!!

je rêverai de savoir faire tout ca tout seul !!