Microsoft 365 Compteur de jours consécutifs travaillés

[Ay-Ricko]

Bonjour,

Je n'arrive pas à trouver la formule magique à mon besoin :/

Sur le fichier ci-joint, j'ai 3 feuilles :
La première est une extraction pure d'un logiciel de pointage
La deuxième est une version "simplifiée" de cette même extraction avec seulement les données qui m’intéresse (surement que je peux m'en passer)
Et la troisième sert quand à elle à recevoir les résultats de la macro

Ce que je souhaiterais, c'est que lorsque je clique sur le bouton sur la feuille trois, les noms se mettent à jour (ça sa fonctionne) et que à coté des noms, ça m'affiche le nombre de séries de jours <10J (hors jour férié et week-end) par personne où il y a "ABS" en colonne E.

Dans la pratique c'est pour savoir si chaque personne à bien pris 10 jours de congé consécutifs.

La liste sur la feuille "extraction brute" est un exemple, la liste réelle fait plusieurs millier de lignes.

Je vous remercie par avance de votre aide

 

[vgendron]

Hello

une proposition à base de dictionnaire, plutot que collection

Sub Bouton1_Cliquer()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim TabBrute() As Variant 'contient toute la feuille "Extraction brute"
    
    Dim DicoEmployés As Object 'déclaration d'un dictionnaire
    
    Set DicoEmployés = CreateObject("scripting.dictionary") ' Dictionnaire


    Set ws1 = ThisWorkbook.Worksheets("Extraction brute")
    Set ws2 = ThisWorkbook.Worksheets("Résultat")
    
    'Effacer le contenu de la colonne B de la feuille "Résultat"
    ws2.Range("B:C") = ClearContents
    
    With ws1
        TabBrute = .UsedRange.Value 'on place la feuille dans le tableau
    End With
    
    'on cherche les noms sans doublons
    For i = LBound(TabBrute, 1) + 1 To UBound(TabBrute, 1) 'pour chaque ligne du tableau (hors entete)
        Nom = TabBrute(i, 3) & " " & TabBrute(i, 4) 'le nom = nom prénom
        If Not DicoEmployés.exists(Nom) Then
            DicoEmployés.Add Nom, 0
        End If
    Next i
    
  
    For Each Nom In DicoEmployés.keys 'pour chaque nom du dico
        'MsgBox Nom
        For i = LBound(TabBrute, 1) + 1 To UBound(TabBrute, 1) 'pour chaque ligne du tablo
            NomTesté = TabBrute(i, 3) & " " & TabBrute(i, 4) 'nom de la ligne i
            NomPrec = TabBrute(i - 1, 3) & " " & TabBrute(i - 1, 4) 'nom de la ligne i-1
            If NomTesté = Nom And NomPrec = Nom Then 'on reste sur le meme nom
                If UCase(TabBrute(i - 1, 19)) = "ABS" And UCase(TabBrute(i, 19)) = "ABS" Then 'si les deux lignes consécutives ont une absence
                    DicoEmployés(Nom) = DicoEmployés(Nom) + 1 'on ajoute 1 à la valeur
                    If DicoEmployés(Nom) >= 10 Then Exit For 'si on a compté au moins 10 jours consécutifs ==> on sort de la boucle for i
                End If
            End If
        Next i
    Next Nom
    
    
    With ws2
         'on transvase
        Nom = DicoEmployés.keys
        .Range("B2").Resize(DicoEmployés.Count) = WorksheetFunction.Transpose(Nom)


        Nom = DicoEmployés.items
        .Range("C2").Resize(DicoEmployés.Count) = WorksheetFunction.Transpose(Nom)
    End With
    ' Libérez la mémoire de l'objet Collection
    Set DicoEmployés = Nothing
    
End Sub

 

[Ay-Ricko]

Merci de ton aide, il y a du mieux en effet.
Cependant je ne comprends pas très bien le chiffre qui est affiché après le nom.
Dans notre exemple, LELOU Jacques à 2 périodes de dix jours "ABS" consécutifs. et à coté de son nom il est noté 10, et non 2

 

[vgendron]

hello
ah oui pardon, j'avais mal lu: je croyais que tu voulais savoir si il y a avait au moins une série de 10
je regarde pour compter le nombre de séries de 10

 

[vgendron]

nouvel essai

Sub Bouton1_Cliquer()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim TabBrute() As Variant 'contient toute la feuille "Extraction brute"
    Dim DicoEmployés As Object 'déclaration d'un dictionnaire
    
    Set DicoEmployés = CreateObject("scripting.dictionary") ' Dictionnaire
    Set ws1 = ThisWorkbook.Worksheets("Extraction brute")
    Set ws2 = ThisWorkbook.Worksheets("Résultat")
    
    'Effacer le contenu de la colonne B de la feuille "Résultat"
    ws2.Range("B:C") = ClearContents
    
    With ws1
        TabBrute = .UsedRange.Value 'on place la feuille dans le tableau
    End With
    
    'on cherche les noms sans doublons
    For i = LBound(TabBrute, 1) + 1 To UBound(TabBrute, 1) 'pour chaque ligne du tableau (hors entete)
        Nom = TabBrute(i, 3) & " " & TabBrute(i, 4) 'le nom = nom prénom
        If Not DicoEmployés.exists(Nom) Then
            DicoEmployés.Add Nom, 0
        End If
    Next i
       
    For Each Nom In DicoEmployés.keys 'pour chaque nom du dico
        NewSérie = True
        NbSéries = 0
        'MsgBox Nom
        For i = LBound(TabBrute, 1) + 1 To UBound(TabBrute, 1) 'pour chaque ligne du tablo
            NomTesté = TabBrute(i, 3) & " " & TabBrute(i, 4) 'nom de la ligne i
            NomPrec = TabBrute(i - 1, 3) & " " & TabBrute(i - 1, 4) 'nom de la ligne i-1
            
            If NomTesté = Nom And NomPrec = Nom Then 'on reste sur le meme nom
                If UCase(TabBrute(i - 1, 19)) = "ABS" And UCase(TabBrute(i, 19)) = "ABS" Then 'si les deux lignes consécutives ont une absence
                    DicoEmployés(Nom) = DicoEmployés(Nom) + 1 'on ajoute 1 à la valeur
                    If DicoEmployés(Nom) >= 10 Then
                        If NewSérie Then
                            NbSéries = NbSéries + 1 'si on a compté au moins 10 jours consécutifs ==> on sort de la boucle for i
                            NewSérie = False
                        End If
                    End If
                Else
                    DicoEmployés(Nom) = 0
                    NewSérie = True
                End If
            End If
        Next i
        DicoEmployés(Nom) = NbSéries
    Next Nom
        
    With ws2
         'on transvase
        Nom = DicoEmployés.keys
        .Range("B2").Resize(DicoEmployés.Count) = WorksheetFunction.Transpose(Nom)

        Nom = DicoEmployés.items
        .Range("C2").Resize(DicoEmployés.Count) = WorksheetFunction.Transpose(Nom)
    End With
    ' Libérez la mémoire de l'objet Collection
    Set DicoEmployés = Nothing
    
End Sub

 

[Ay-Ricko]

ça fonctionne super merci
Tu crois qu'il est possible de mettre en place une condition où les week-end (et potentiellement les jours fériés) ne soit pas compter dans la série de 10 ?