XL 2021 Classement par équipe

CDR77 · 19 Août 2023

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

job75 · 19 Août 2023

CDR77 à dit:
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...

chris · 19 Août 2023

Cross post !!!

Baroute78 sera content de retrouver son travail ici !

job75 · 19 Août 2023

Bonjour,

Que fait-on avec les coureurs sans club ? On les ignore ?

A+

CDR77 · 19 Août 2023

Bonjour Job75
Oui on ne garde que les coureurs licenciés du 077

bsalv · 19 Août 2023

bonjour le fil,

CDR77 · 19 Août 2023

bsalv à dit:
bonjour le fil,

Merci à toi ! ca fonctionne bien ! Il ne me reste plus qu'a rendre tout ça dynamique pour l'insérer sur les fichiers tout au long de la saison. Je veux bien que tu me détaille un peu comment tu as procédé.

bsalv · 19 Août 2023

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.

CDR77 · 19 Août 2023

bsalv à dit:
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.

job75 · 19 Août 2023

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+

CDR77 · 19 Août 2023

job75 à dit:

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

job75 · 19 Août 2023

CDR77 à dit:
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.

CDR77 · 22 Août 2023

Ca fonctionne ! Merci

XL 2021 Classement par équipe

CDR77

XLDnaute Nouveau

Pièces jointes

job75

chris

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

CDR77

XLDnaute Nouveau

bsalv

XLDnaute Occasionnel

Pièces jointes

CDR77

XLDnaute Nouveau

bsalv

XLDnaute Occasionnel

CDR77

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

CDR77

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

CDR77

XLDnaute Nouveau

Discussions similaires