XL 2021 Classement par équipe

  • Initiateur de la discussion Initiateur de la discussion CDR77
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

CDR77

XLDnaute Nouveau
Bonjour à tous

J'ai un fichier de classement de course à pied ou je souhaiterai effectuer un classement par équipe selon la règle suivante.

On ne garde que les clubs du 077
Les 5 meilleurs temps cumulés H/F confondus pour le classement club mixte
Les 3 meilleurs temps cumulés pour le classement femmes.

De là 3 questions

Comment extraire les clubs ayant au moins 5 coureurs du même club ?
Comment cumuler leurs temps ?
Comment attribuer les points de l'équipe la plus rapide à la moins rapide ?

J'ai mis mon fichier en exemple ce qui sera sans doute plus parlant que par mes explications

Je reste à disposition pour plus d'infos

Remerciant par avance celui ou celle qui pourra éclairer ma lanterne
 

Pièces jointes

Solution
Faut que j'arrive à comprendre comment la faire fonctionner sur plusieurs feuilles.
Voyez ce fichier (2) et la macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, nplage As Byte, mini As Byte, h&, i&, nombre&, lig&, n As Byte, v#, j&
If Sh.Index = 1 Or Sh.Index > 3 Then Exit Sub
Application.ScreenUpdating = False
Set P = Sh.[B3:C12] 'plage à remplir
nplage = Sh.Index - 1
mini = IIf(nplage = 1, 5, 3)
P.ClearContents 'RAZ
With [BRIE_DES_MORINS] 'tableau structuré
    .Sort .Columns(7), xlAscending, .Columns(6), , xlAscending, .Columns(10), xlAscending, Header:=xlYes 'tri sur 3 colonnes
    h = Application.CountIf(.Columns(7), "077")
    If h = 0 Then Exit Sub
    With...
U18 est une formule "unique" pour tous les club du département "077", le nombre de lignes sera le nombre de clubs, donc indéfini. Puis chaque colonne à côté calcule pour chaque club le cumul de top-5 mixte et du top-3 feminine et les 2 colonnes à côté calculent le rang.
Puis avec RechercheX, on met cet information dans vos 2 tableaux.
 
U18 est une formule "unique" pour tous les club du département "077", le nombre de lignes sera le nombre de clubs, donc indéfini. Puis chaque colonne à côté calcule pour chaque club le cumul de top-5 mixte et du top-3 feminine et les 2 colonnes à côté calculent le rang.
Puis avec RechercheX, on met cet information dans vos 2 tableaux.
Ok ça marche ! je connaissais Unique et rechercheX , en revanche je me questionnais sur les deux dernières colonnes qui calculent le rang.
Bon je m'attache à pouvoir implémenter tout ça de façon dynamique sur les fichiers à venir.

Encore Merci.
 
Re, bonjour bsalv,

Une solution VBA avec cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, nplage As Byte, lig&, mini As Byte, h&, i&, nombre&, n As Byte, v#, j&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Set P = [O18:P27,O34:P43] 'plage à remplir
For nplage = 1 To P.Areas.Count
    lig = 0
    mini = IIf(nplage = 1, 5, 3)
    P.Areas(nplage).ClearContents 'RAZ
    With [BRIE_DES_MORINS] 'tableau structuré
        .Sort .Columns(7), xlAscending, .Columns(6), , xlAscending, .Columns(10), xlAscending, Header:=xlYes 'tri sur 3 colonnes
        h = Application.CountIf(.Columns(7), "077")
        If h = 0 Then Exit Sub
        With .Rows(Application.Match("077", .Cells(7), 0)).Resize(h)
            For i = 1 To h
                If .Cells(i, 6) <> .Cells(i - 1, 6) Then
                    If nplage = 1 Then
                        nombre = Application.CountIf(.Columns(6), .Cells(i, 6))
                    Else
                        nombre = Application.CountIfs(.Columns(6), .Cells(i, 6), .Columns(11), "F")
                    End If
                    If nombre >= mini Then
                        lig = lig + 1
                        Cells(lig, "AA") = .Cells(i, 6) 'colonne AA auxiliaire
                        If nplage = 1 Then
                            Cells(lig, "AB") = Application.Sum(.Cells(i, 10).Resize(mini)) 'colonne AB auxiliaire
                        Else
                            n = 0
                            v = 0
                            For j = i To h
                                If UCase(.Cells(j, 11)) = "F" Then _
                                    v = v + .Cells(j, 10): n = n + 1: If n = mini Then Exit For
                            Next j
                            Cells(lig, "AB") = v 'colonne AB auxiliaire
                        End If
                    End If
                End If
            Next i
        End With
    End With
    '---restitution---
    If lig Then
        [AA:AB].Sort Columns("AB"), xlAscending, Header:=xlNo
        P.Areas(nplage) = [AA1:AB10].Value
    End If
    [AA:AB].ClearContents 'RAZ
Next nplage
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

A+
 

Pièces jointes

Re, bonjour bsalv,

Une solution VBA avec cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, nplage As Byte, lig&, mini As Byte, h&, i&, nombre&, n As Byte, v#, j&
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Set P = [O18:P27,O34:P43] 'plage à remplir
For nplage = 1 To P.Areas.Count
    lig = 0
    mini = IIf(nplage = 1, 5, 3)
    P.Areas(nplage).ClearContents 'RAZ
    With [BRIE_DES_MORINS] 'tableau structuré
        .Sort .Columns(7), xlAscending, .Columns(6), , xlAscending, .Columns(10), xlAscending, Header:=xlYes 'tri sur 3 colonnes
        h = Application.CountIf(.Columns(7), "077")
        If h = 0 Then Exit Sub
        With .Rows(Application.Match("077", .Cells(7), 0)).Resize(h)
            For i = 1 To h
                If .Cells(i, 6) <> .Cells(i - 1, 6) Then
                    If nplage = 1 Then
                        nombre = Application.CountIf(.Columns(6), .Cells(i, 6))
                    Else
                        nombre = Application.CountIfs(.Columns(6), .Cells(i, 6), .Columns(11), "F")
                    End If
                    If nombre >= mini Then
                        lig = lig + 1
                        Cells(lig, "AA") = .Cells(i, 6) 'colonne AA auxiliaire
                        If nplage = 1 Then
                            Cells(lig, "AB") = Application.Sum(.Cells(i, 10).Resize(mini)) 'colonne AB auxiliaire
                        Else
                            n = 0
                            v = 0
                            For j = i To h
                                If UCase(.Cells(j, 11)) = "F" Then _
                                    v = v + .Cells(j, 10): n = n + 1: If n = mini Then Exit For
                            Next j
                            Cells(lig, "AB") = v 'colonne AB auxiliaire
                        End If
                    End If
                End If
            Next i
        End With
    End With
    '---restitution---
    If lig Then
        [AA:AB].Sort Columns("AB"), xlAscending, Header:=xlNo
        P.Areas(nplage) = [AA1:AB10].Value
    End If
    [AA:AB].ClearContents 'RAZ
Next nplage
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

A+
C'est excellent avec la macro ! Quelle réactivité ! Faut que j'arrive à comprendre comment la faire fonctionner sur plusieurs feuilles. je maitrise pas suffisamment le vba pour le moment 🙂
 
Faut que j'arrive à comprendre comment la faire fonctionner sur plusieurs feuilles.
Voyez ce fichier (2) et la macro dans ThisWorkbook :
VB:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, nplage As Byte, mini As Byte, h&, i&, nombre&, lig&, n As Byte, v#, j&
If Sh.Index = 1 Or Sh.Index > 3 Then Exit Sub
Application.ScreenUpdating = False
Set P = Sh.[B3:C12] 'plage à remplir
nplage = Sh.Index - 1
mini = IIf(nplage = 1, 5, 3)
P.ClearContents 'RAZ
With [BRIE_DES_MORINS] 'tableau structuré
    .Sort .Columns(7), xlAscending, .Columns(6), , xlAscending, .Columns(10), xlAscending, Header:=xlYes 'tri sur 3 colonnes
    h = Application.CountIf(.Columns(7), "077")
    If h = 0 Then Exit Sub
    With .Rows(Application.Match("077", .Cells(7), 0)).Resize(h)
        For i = 1 To h
            If .Cells(i, 6) <> .Cells(i - 1, 6) Then
                If nplage = 1 Then
                    nombre = Application.CountIf(.Columns(6), .Cells(i, 6))
                Else
                    nombre = Application.CountIfs(.Columns(6), .Cells(i, 6), .Columns(11), "F")
                End If
                If nombre >= mini Then
                    lig = lig + 1
                    Cells(lig, "AA") = .Cells(i, 6) 'colonne AA auxiliaire
                    If nplage = 1 Then
                        Cells(lig, "AB") = Application.Sum(.Cells(i, 10).Resize(mini)) 'colonne AB auxiliaire
                    Else
                        n = 0
                        v = 0
                        For j = i To h
                            If UCase(.Cells(j, 11)) = "F" Then _
                                v = v + .Cells(j, 10): n = n + 1: If n = mini Then Exit For
                        Next j
                        Cells(lig, "AB") = v 'colonne AB auxiliaire
                    End If
                End If
            End If
        Next i
    End With
End With
'---restitution---
If lig Then
    [AA:AB].Sort Columns("AB"), xlAscending, Header:=xlNo
    P = [AA1:AB10].Value
End If
[AA:AB].ClearContents 'RAZ
End Sub
Elle se déclenche quand on active une feuille de résultats.

Qui doit être en 2ème ou 3ème position.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
15
Affichages
2 K
Retour