Faire un recap du pointage journalier des dates succesives

Bonjour les experts ,

j'ai besoin de votre aide propos d'un pointage journalier que je doit faire un recap chaque fin de mois manuellement , j'ai besoin de le faire automatique avec excel par ce que je traite des centaine de ligne et ça me prit beaucoup de temps , vous trouver si joint un exemple du fichier de pointage ainsi que le recap .

merci a vous.

bonjour,

une proposition via une macro

Sub aargh()
    pl = 7 'premiere ligne sur pointage
    With Sheets("pointage")
        dl = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A" & pl, .Cells(dl, 3)).Sort key1:=.Range("B1"), order1:=xlAscending, key2:=.Range("C1"), order2:=xlAscending, key3:=.Range("A1"), order3:=xlAscending, Header:=xlNo
        ke = "": kl = "": l = 5 'premiere ligne sur recap
        Set rc = Sheets("recap")
        rc.Range("A6:D1000").ClearContents
        For i = pl To dl
            If .Cells(i, 2) <> ke Or .Cells(i, 3) <> kl Then
                If i <> pl Then
                    l = l + 1
                    rc.Cells(l, 1) = ke 'engin
                    rc.Cells(l, 2) = fd ' première date
                    rc.Cells(l, 3) = ld ' dernière date
                    rc.Cells(l, 4) = kl 'emplacement
                End If
                fd = .Cells(i, 1)
                ke = .Cells(i, 2)
                kl = .Cells(i, 3)
                ld = .Cells(i, 1)
            Else
                ld = .Cells(i, 1)
            End If
        Next i
    End With
End Sub

Bonjour,

Sub Récap()
    Dim TR(), r%, n%, i%
    With Worksheets("POINTAGE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A6:C" & n).Sort key1:=.Range("B6"), order1:=xlAscending, key2:=.Range("A6"), _
         order2:=xlAscending, Header:=xlYes
        ReDim TR(3, 0): TR(0, 0) = .Cells(7, 2)
        TR(1, 0) = .Cells(7, 1).Value2: TR(2, 0) = .Cells(7, 1).Value2: TR(3, 0) = .Cells(7, 3)
        For i = 8 To n
            If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 3) = .Cells(i - 1, 3) Then
                TR(2, r) = .Cells(i, 1).Value2
            Else
                r = r + 1: ReDim Preserve TR(3, r): TR(0, r) = .Cells(i, 2)
                TR(1, r) = .Cells(i, 1).Value2: TR(2, r) = .Cells(i, 1).Value2: TR(3, r) = .Cells(i, 3)
            End If
        Next i
    End With
    With Worksheets("RECAP")
        .Range("A5").CurrentRegion.Offset(1).Clear
        With .Range("A6").Resize(r + 1, 4)
            .Value = WorksheetFunction.Transpose(TR)
            .HorizontalAlignment = xlCenter
            .Columns("B:C").NumberFormat = "dd/mm/yyyy"
            With .Borders
                .LineStyle = xlContinuous: Weight = xlThin
            End With
        End With
        .Activate
    End With
End Sub

Salut h2so4 !

C'est quasi pareil ! Bon... !

vraiment un grand merci a vous MFerrand et h2so4 pour votre honorable réponse, mais il reste un petit souci , Mais ce que je veux exactement est de grouper par dates successives et par emplacement , vous trouvez le détail sur l’exemple.

merci infiniment.

Bonsoir,

une correction en integrant le mise en forme proposée par MFERRAND

Sub aargh()
    pl = 7 'premiere ligne sur pointage
   With Sheets("pointage")
        dl = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range("A" & pl, .Cells(dl, 3)).Sort key1:=.Range("B1"), order1:=xlAscending, key2:=.Range("C1"), order2:=xlAscending, key3:=.Range("A1"), order3:=xlAscending, Header:=xlNo
        ke = "": kl = "": l = 5 'premiere ligne sur recap
       Set rc = Sheets("recap")
        rc.Range("A6:D1000").ClearContents
        For i = pl To dl
            If .Cells(i, 2) <> ke Or .Cells(i, 3) <> kl Or .Cells(i, 1) - 1 <> ld Then
                If i <> pl Then
                    l = l + 1
                    rc.Cells(l, 1) = ke 'engin
                   rc.Cells(l, 2) = fd ' première date
                   rc.Cells(l, 3) = ld ' dernière date
                   rc.Cells(l, 4) = kl 'emplacement
               End If
                fd = .Cells(i, 1)
                ke = .Cells(i, 2)
                kl = .Cells(i, 3)
                ld = .Cells(i, 1)
            Else
                ld = .Cells(i, 1)
            End If
        Next i
    End With
    With Sheets("recap")
        With .Range("A6").Resize(l, 4)
            .Sort key1:=.Range("A1"), order1:=xlAscending, key2:=.Range("B1"), order2:=xlAscending
            .HorizontalAlignment = xlCenter
            .Columns("B:C").NumberFormat = "dd/mm/yyyy"
            With .Borders
                .LineStyle = xlContinuous: Weight = xlThin
            End With
        End With
        .Activate
    End With
End Sub

Modification :

            If .Cells(i, 2) = .Cells(i - 1, 2) And .Cells(i, 3) = .Cells(i - 1, 3) And _
             .Cells(i, 1).Value2 = TR(2, r) + 1 Then
                TR(2, r) = .Cells(i, 1).Value2
            Else

Vraiment rien a dire , merci infiniment MFerrand et h2so4 pour votre collaboration.