Calcul temps de travail (trajets) jour par jour

Bonjour à tous et à toutes,

Je suis bloqué depuis plusieurs jours dans l'élaboration d'une macro/code VBA. Vous trouverez ci-joint le fichier allégé :

- J'ai réalisé plusieurs petites fonctions afin d'obtenir ce format. En colonne E j'ai la différence entre l'heure de fin et l'heure de début afin d'avoir la durée de chaque trajet : Concrètement je souhaite parcourir les lignes jour par jour afin de noter l'Heure de fin (colonne D) associé à la première durée > 00:10:00. Cette heure de fin est ensuite affiché dans la première cellule vide en colonne C. Afin de pouvoir réaliser la différence entre la dernière heure de début et la première heure de fin (où la durée est > 10 min) dans le but de calculer le temps de travail sur la journée sans prendre en compte les déplacements domicile - lieu de travail.

Je rencontre beaucoup de difficultés pour parcourir et réaliser les calculs jour par jour.

- Le deuxième point est lorsque je récupère mes dates, initialement au format "mar. 10/06/2023", je supprime tout les caractères avant 10/06/2023 mais Excel inverse automatiquement date et jour malgré que le format de la colonne est bien FR. 02/06/2023 devient 06/02/2023 et impossible de débuguer ceci...

Je vous remercie de votre aide qui me sera très utile à l'avenir pour réaliser des scripts de genre (étude jour par jour et réinitiliasation de variables)

Cdt

Ce que j'ai actuellement :

Sub ModifierHeureFin()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim jourActuel As String
    Dim premierJour As Boolean

    Set ws = ThisWorkbook.Worksheets("NomDeVotreFeuille")

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' Initialiser les variables
    premierJour = True

    ' Boucle à travers les lignes
    For i = 2 To lastRow
        If ws.Cells(i, 2).Value <> "" Then
            ' Nouveau jour trouvé
            jourActuel = ws.Cells(i, 2).Value
            premierJour = True
        End If

        If premierJour Then
            If ws.Cells(i, 5).Value > TimeValue("00:10:00") Then
                ' Trouver la première cellule vide en colonne C pour le jour actuel
                ws.Cells(i, 3).Value = ws.Cells(i, 4).Value
                premierJour = False
            End If
        End If
    Next i
End Sub

Re-bonjour,

J'ai un peu avancé sur le script, j'ai l'impression d'avancer dans la bonne direction mais lorsque j'execute malheureusement "rien ne se passe" (je vérifie les formats de cellules car j'ai parfois des cellules vides), enfin pour l'affichage de la valeur de la colonne D dans la première prochaine cellule vide en C, j'ai essayé avec "targetrow" mais je suis toujours bloqué :'( :

Sub ParcourirDonnees()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentDate As Date
    Dim currentTime As Date
    Dim checkTime As Date
    Dim rowIndex As Long
    Dim targetRow As Long

    Set ws = ThisWorkbook.Sheets("Résumé")

    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    targetRow = 1
    currentDate = ws.Cells(2, "B").value

    ' Parcourir les lignes
    For rowIndex = 2 To lastRow ' Commence à partir de la deuxième ligne (supposant qu'il y a un en-tête)
        ' Vérifier si la valeur en colonne B est une date
        If IsDate(ws.Cells(rowIndex, "B").value) Then
            ' Vérifier si la valeur en colonne B est différente de la date précédente
            If ws.Cells(rowIndex, "B").value <> currentDate Then
                ' Récupérer la date actuelle
                currentDate = ws.Cells(rowIndex, "B").value
                ' Réinitialiser l'heure de vérification
                currentTime = 0
            End If

            ' Vérifier si la valeur en colonne E est un format d'heure valide
            If IsTime(ws.Cells(rowIndex, "E").value) Then
                ' Vérifier si l'heure est supérieure à 00:10:00
                If ws.Cells(rowIndex, "E").value > TimeValue("00:10:00") Then
                    ' Vérifier si l'heure actuelle est déjà définie ou si l'heure actuelle est supérieure à l'heure de vérification
                    If currentTime = 0 Or TimeValue(ws.Cells(rowIndex, "E").value) > checkTime Then
                        ' Mettre à jour l'heure de vérification
                        checkTime = TimeValue(ws.Cells(rowIndex, "E").value)
                        ' Récupérer la donnée en colonne D
                        ws.Cells(targetRow, "C").value = ws.Cells(rowIndex, "D").value
                        ' Passer au jour suivant en arrêtant la boucle
                        Exit For
                    End If
                End If
            End If
        End If
    Next rowIndex
End Sub

Function IsTime(ByVal value As Variant) As Boolean
    ' Vérifier si la valeur est un format d'heure valide (hh:mm:ss)
    On Error Resume Next
    IsTime = (IsDate("01/01/2000 " & value) And Hour("01/01/2000 " & value) > 0)
    On Error GoTo 0
End Function

Bonjour Hemeris,
pas évident de comprendre très précisément ce que vous souhaitez.
La feuille que vous joignez n'éclaire pas plus, les colonnes C et D ont les mêmes valeurs ligne à ligne, la colonne E est toujours > 10', et une seule date en colonne B.
Je vous suggère de modifier votre fichier en donnant un tableau avec la situation "Avant" avec suffisamment de cas pour que la règle soit claire et un tableau avec la situation "Après".
Ainsi que la façon dont vous procédez pour saisir vos valeurs (une fois par jour, à chaque temps de travail). Et quand vous activez votre macro.
Cela permettra au forum de vous proposer une solution adaptée.

Bonjour,

Après plus de 20 heures en deux jours j"ai réussi à trouver la solution par moi-même. C'est maintenant opérationnel et le rapport s'envoie automatiquement par mail. Merci