Microsoft 365 Compteur de jours consécutifs travaillés

Ay-Ricko

XLDnaute Nouveau
Supporter XLD
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 ;)
 

Pièces jointes

  • Extraction test1.xlsm
    40.8 KB · Affichages: 18

vgendron

XLDnaute Barbatruc
Hello

une proposition à base de dictionnaire, plutot que collection

VB:
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
 

vgendron

XLDnaute Barbatruc
nouvel essai

VB:
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
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 922
Messages
2 093 644
Membres
105 775
dernier inscrit
assen