Macro Calcul entre deux date

Bonjour à tous,

J’aurais encore une fois, besoin de vos conseils.

J’ai une feuille nommée « Pointage », qui récapitule mes heures de travail tous les jours.

Sur cette feuille, il est aussi possible de calculer les heures qui seront affectées à un compteur RTT, ainsi que les heures supplémentaires.

J’ai réalisé une macro « CalculHeurePeriode » qui me permet, dans une autre feuille nommée « Data », de retrouver les heures effectuées en fonction des dates de début et de fin spécifiées.

Jusque-là tous va bien.

Mon souhait serait que pour la même période donnée, j’affiche le nombre d’heures de RTT et supplémentaires.

J’ai un peu réussi.

Seulement le report des heures RTT et supplémentaires doivent s’effectuer, qu’à partir du moment où les date de travail contenu dans la période, soit au moins égale à la moitié de la semaine.

J’ai mis un exemple dans mon fichier.

J’espère avoir formulé correctement ma demande, sinon demandez-moi

Merci encore

Titi32600

Slt titi32600,

essaie comme ca (j'éspère avoir compris le but )

Sub CalculHeurePeriode()
Dim dt1 As Date
Dim dt2 As Date
Dim Lng As Integer
Dim Cln As Integer
Dim X As Integer

X = 5
dt1 = Sheets("Data").Cells(5, 75)
dt2 = Sheets("Data").Cells(6, 75)

' Calcule et affihe les heures effectuées dans la période
With Sheets("pointage")
    For Lng = 13 To 325 Step 6 'Indique les ligne contenant les dates
        For Cln = 6 To 12 ' Indique les colonnes contenant une date
            If .Cells(Lng, Cln) >= dt1 And .Cells(Lng, Cln) <= dt2 Then
                Sheets("Data").Range("BX" & X) = .Cells(Lng + 1, Cln).Value
                    ' Calcule et affiche les heures SUP effectuées dans la période
                    If Cln = 12 And .Cells(Lng, Cln) >= dt1 + 2 And .Cells(Lng, Cln) <= dt2 - 2 Then
                        Sheets("Data").Range("BZ" & X) = .Cells(Lng + 1, 23).Value
                        ' Calcule et affiche les heures RTT effectuées dans la période
                        Sheets("Data").Range("BY" & X) = .Cells(Lng + 2, 17).Value
                    End If
                X = X + 1
            End If
        Next
    Next
End With
End Sub

Slt m3ellem1,

Merci encore de ton aide.

Effectivement cela marche très bien pour certaine période "du 01 au 30/04/2019" et "du 01 au 31/07/2019"

Seulement, pour les période du "01 au 31/05/2019" et "01 au 030/06/2019", il me manque les données de la dernières ligne de la période même en modifiant les valeur +2 et -2 du code

If Cln = 12 And .Cells(Lng, Cln) >= dt1 +2 And .Cells(Lng, Cln) <= dt2 -2 Then

si je change en +2 et -0, les résultats sont assez probants, sauf pour la période du mois de mai.

je continu moi aussi a chercher une solution

titi32600

Slt,

Ben dans ce cas, il faut ajouter une loupe ou creer une fonction qui calcule le nombre de jours de chaque NO.SEMAINE ET si ce nombre est plus grand que 3 alors il passe a ta boucle sinon il passe a la prochaine semaine!

un essai

Sub CalculHeurePeriode()
Dim dt1 As Date
Dim dt2 As Date
Dim rng As Range
Dim Lng As Integer
Dim Cln As Integer
Dim X As Integer, T As Integer, Z As Integer

Set rng = Sheets("Data").Range("BX4:BZ34")
rng.ClearContents
X = 5
dt1 = Sheets("Data").Cells(5, 75)
dt2 = Sheets("Data").Cells(6, 75)
Z = Month(Sheets("Data").Cells(5, 75))

' Calcule et affihe les heures effectuées dans la période
With Sheets("pointage")
    For Lng = 13 To 325 Step 6 'Indique les ligne contenant les dates
        For Cln = 6 To 12 ' Indique les colonnes contenant une date

            If .Cells(Lng, Cln) >= dt1 And .Cells(Lng, Cln) <= dt2 Then
                Sheets("Data").Range("BX" & X) = .Cells(Lng + 1, Cln).Value
                    'Calcule du nombre de jours qu'appartiennent au mois choisi dans une semaine
                    T = Evaluate("=SUMPRODUCT(--(MONTH('pointage'!F" & Lng & ":L" & Lng & ")=" & Z & "))")
                    ' Calcule et affiche les heures SUP effectuées dans la période
                    If Cln = 12 And T > 3 Then  ' ici la condition T > 3 peut être adapter
                        Sheets("Data").Range("BZ" & X) = .Cells(Lng + 1, 23).Value
                        ' Calcule et affiche les heures RTT effectuées dans la période
                        Sheets("Data").Range("BY" & X) = .Cells(Lng + 2, 17).Value
                    End If
                X = X + 1
            End If
        Next
    Next
End With
End Sub

Slt,

Effectivement ça arrange bien les choses.

le résultat est parfait pour la plupart des mois, mais reste toujours le mois de mai qui me pose des problèmes.

le résultat des RTT de la dernière semaine du mois de mai ne s’affiche pas.

En tout cas, merci encore de ton aide

tit32600

oui je viens de voir,

le problème vient de cette condition

And .Cells(Lng, Cln) <= dt2

il faut peut être créer une boucle if extra pour le moi de mai, je regarde demain ..

Bonne nuit

Slt

Ok pas de problème

Titi32600