Calcul d'heures ouvrées

**kenobyalex** · 23/04/2008, 16h11

Bonjour,

Voici mon problème :

Je dois calculer un délai entre 2 dates en heures et jours ouvrés, entre 09h00 et 18h00 en otant les weekend et jours fériés.
Par exemple entre le 04/04/2008 13:45 et le 07/04/2008 17h45, il faut que je ressorte 13h (04h15 le 04, 5et6 weekend et 8h45 le 07).

J'ai trouvé ducode sur le forum mais je n'arrive pas à l' adapter.
Voici mon code qui donne un résultat aléatoir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
 
 
'Parcour mon tab Excel
For p = 2 To Cells(65535, 1).End(xlUp).Row
 
'Stock des dates et heures dans variables
Dt_Clos = Format(Range("D" & p).Value, "dd/mm/yy")
Dt_Ouvert = Format(Range("C" & p).Value, "dd/mm/yy")
H_Clos = Format(Range("D" & p).Value, "hh:mm")
H_Ouvert = Format(Range("C" & p).Value, "hh:mm")
 
    Heures = 1 / 24     '0.041666666667 (N° de série)
        DateDemande = Dt_Ouvert
        DateTraitement = Dt_Clos
        HeureDemande = H_Clos
        HeureTraitement = H_Ouvert
 
    'Calcul horaire entre heure de la demande et heure du traitement
'Ici je ne comprend pas bien le calcul :-))
    If TimeValue(HeureTraitement) > TimeValue(HeureDemande) Then
            TpsHeureTraitement = TimeValue(HeureTraitement) - TimeValue(HeureDemande)
        Else
            TpsHeureTraitement = (9 * Heures) - (TimeValue(HeureDemande) - TimeValue(HeureTraitement))
    End If
    JourFérié = Array("01/01/2008") ' etc
    n = 0
    For i = DateValue(DateDemande) + 1 To DateValue(DateTraitement)
        If CStr(Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
            For n = 0 To UBound(JourFérié)
                Férié = i = DateValue(JourFérié(n)) ''si vrai, Férié = -1
                If Férié Then Exit For
            Next
            'si on a un jour férié, on le retranche
            NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
        End If
    Next
    If TimeValue(HeureTraitement) < TimeValue(HeureDemande) Then NbJoursOuvrés = NbJoursOuvrés - 1
    If TpsHeureTraitement >= (9 * Heures) Then
        NbreJrs = Int((TpsHeureTraitement / (9 * Heures)) + 0.0000001) 'ROUNDUP/ARRONDI.SUP
        NbJoursOuvrés = NbJoursOuvrés + NbreJrs
        TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * NbreJrs)
    End If
    délaiH = Format(TpsHeureTraitement, "hh:nn")
    'MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
    Cellule_Result = NbJoursOuvrés & "jours" & " " & délaiH
    Range("E" & p) = Cellule_Result
 NbJoursOuvrés = 1
 délaiH = 0
Next
End Sub

Il y a plusieurs choses que je ne comprend pas dans ce code.
Il calcul déjà les jours fériès, et test si les jours sont des jours de semaines.

Merci d'avance.

**Le Pierre** · 23/04/2008, 18h55

bonjour

Voici le code rectifié que j'ai testé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Sub JourOuvré()
    'Parcour mon tab Excel
    For p = 2 To Cells(65535, 1).End(xlUp).Row
         
        'Stock des dates et heures dans variables
        Dt_Clos = Format(Range("D" & p).Value, "dd/mm/yy")
        Dt_Ouvert = Format(Range("C" & p).Value, "dd/mm/yy")
        H_Clos = Format(Range("D" & p).Value, "hh:mm")
        H_Ouvert = Format(Range("C" & p).Value, "hh:mm")
         
        Heures = 1 / 24     '0.041666666667 (N° de série)
            DateDemande = Dt_Ouvert
            DateTraitement = Dt_Clos
            HeureDemande = H_Clos
            HeureTraitement = H_Ouvert
     
        'Calcul horaire entre heure de la demande et heure du traitement
    'Ici je ne comprend pas bien le calcul :-))
        If TimeValue(HeureTraitement) > TimeValue(HeureDemande) Then
                TpsHeureTraitement = TimeValue(HeureTraitement) - TimeValue(HeureDemande)
            Else
                ''TpsHeureTraitement = (9 * Heures) - (TimeValue(HeureDemande) - TimeValue(HeureTraitement)) 
               TpsHeureTraitement = TimeValue(HeureDemande) - TimeValue(HeureTraitement)
        End If
        JourFérié = Array("01/01/2008", "24/03/2008") ' etc
        n = 0
        ''For i = DateValue(DateDemande) + 1 To DateValue(DateTraitement)
        For i = DateValue(DateDemande) To DateValue(DateTraitement)
            If CStr(Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
                For n = 0 To UBound(JourFérié)
                    Férié = i = DateValue(JourFérié(n)) ''si vrai, Férié = -1
                    If Férié Then Exit For
                Next
                'si on a un jour férié, on le retranche
                NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
            End If
        Next
        If TimeValue(HeureTraitement) < TimeValue(HeureDemande) Then NbJoursOuvrés = NbJoursOuvrés - 1
        If TpsHeureTraitement >= (9 * Heures) Then
            NbreJrs = Int((TpsHeureTraitement / (9 * Heures)) + 0.0000001) 'ROUNDUP/ARRONDI.SUP
            NbJoursOuvrés = NbJoursOuvrés + NbreJrs
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * NbreJrs)
        End If
        délaiH = Format(TpsHeureTraitement, "hh:nn")
        'MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
        Cellule_Result = NbJoursOuvrés & " jours " & délaiH
        Range("E" & p) = Cellule_Result
        NbJoursOuvrés = 1
        délaiH = 0
    Next p
End Sub

j'ai indiqué en bleu les points que j'ai modifié et qui me posaient problème.
Par contre il va falloir compléter la liste des jours fériés (en vert), et mieux, établir un module pour calculer les jours fériés automatiquement.
à plus

**Le Pierre** · 23/04/2008, 19h13

je me suis un peu trop précipité dans mon test : il y a encore un problème à régler lorsque l'heure de fin est inférieure à celle du début.
à suivre donc ...

**Le Pierre** · 24/04/2008, 11h25

bonjour

voici un code qui devrait fonctionner :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub JourOuvré()
    NbJoursOuvrés = 0
    HeureRefDeb = TimeValue("9:00")
    HeureRefFin = TimeValue("18:00")
    FlagNonOuvré = 0
 
    'Parcour mon tab Excel
    For p = 2 To Cells(65535, 1).End(xlUp).Row
        'Stock des dates et heures dans variables
        Dt_Clos = Format(Range("D" & p).Value, "dd/mm/yy")
        Dt_Ouvert = Format(Range("C" & p).Value, "dd/mm/yy")
        H_Clos = Format(Range("D" & p).Value, "hh:mm")
        H_Ouvert = Format(Range("C" & p).Value, "hh:mm")
 
        Heures = 1 / 24     '0.041666666667 (N° de série)
            DateDemande = DateValue(Dt_Ouvert)
            DateTraitement = DateValue(Dt_Clos)
            HeureDemande = TimeValue(H_Clos)
            HeureTraitement = TimeValue(H_Ouvert)
 
        'Calcul horaire entre heure de la demande et heure du traitement
        TpsHeureTraitement = (HeureRefFin - HeureTraitement) + (HeureDemande - HeureRefDeb)
        If DateDemande = DateTraitement Then TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
 
        If TpsHeureTraitement >= (18 * Heures) Then
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
        End If
 
        'on considère que le 1er et dernier jour sont des jours ouvrés
        For i = DateDemande + 1 To DateTraitement - 1
            If CStr(Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
                Call VerifFerié(i, Férié)
                'si on a un jour férié, on le retranche
                NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
            End If
        Next
        'on contrôle si 1er et dernier jour sont des jours ouvrés
        If Not CStr(Application.WorksheetFunction.Weekday(DateDemande)) Like ("[2-6]") Then FlagNonOuvré = 1
        If Not CStr(Application.WorksheetFunction.Weekday(DateTraitement)) Like ("[2-6]") Then FlagNonOuvré = 1
        Call VerifFerié(DateDemande, Férié)
        If Férié = True Then FlagNonOuvré = 1
        Call VerifFerié(DateTraitement, Férié)
        If Férié = True Then FlagNonOuvré = 1
 
        NbJoursOuvrés = NbJoursOuvrés + Int((24 * TpsHeureTraitement) / 9)
        If TpsHeureTraitement >= (9 * Heures) Then
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * (NbreJrs + 1))
        End If
        délaiH = Format(TpsHeureTraitement, "hh:mm")
 
        'MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
        Cellule_Result = NbJoursOuvrés & " jours " & délaiH
        If FlagNonOuvré = 0 Then
            Range("E" & p) = Cellule_Result
        Else
            Range("E" & p) = "Date début ou fin : jour non ouvré !"
        End If
        NbJoursOuvrés = 0
        délaiH = 0
        FlagNonOuvré = 0
    Next p
End Sub
 
Sub VerifFerié(DateAtraiter, Férié)
    JourFérié = Array("01/01/2008", "24/03/2008") ' etc
    For n = 0 To UBound(JourFérié)
        Férié = DateAtraiter = DateValue(JourFérié(n)) ''si vrai, Férié = -1
        If Férié Then Exit For
    Next
End Sub

il reste bien sûr à établir la liste des jours fériés.
à plus

**kenobyalex** · 28/04/2008, 10h45

Merci pour ta réponse, j'étais en formation fin de semaine dernière je n'ai pas pu checker le net.

La macro fonctionne très bien mais y aurait-il un moyen d'afficher par exemple :

12:10 à la place de 1 jours et 3h10?

Merci encore sinon tout est ok.

**Le Pierre** · 28/04/2008, 12h12

bonjour

voici le code rectifié (en bleu) pour afficher le total d'heures :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Sub JourOuvré()
    NbJoursOuvrés = 0
    HeureRefDeb = TimeValue("9:00")
    HeureRefFin = TimeValue("18:00")
    FlagNonOuvré = 0
    
    'Parcour mon tab Excel
    For p = 2 To Cells(65535, 1).End(xlUp).Row
        'Stock des dates et heures dans variables
        Dt_Clos = Format(Range("D" & p).Value, "dd/mm/yy")
        Dt_Ouvert = Format(Range("C" & p).Value, "dd/mm/yy")
        H_Clos = Format(Range("D" & p).Value, "hh:mm")
        H_Ouvert = Format(Range("C" & p).Value, "hh:mm")
         
        Heures = 1 / 24     '0.041666666667 (N° de série)
            DateDemande = DateValue(Dt_Ouvert)
            DateTraitement = DateValue(Dt_Clos)
            HeureDemande = TimeValue(H_Clos)
            HeureTraitement = TimeValue(H_Ouvert)
     
        'Calcul horaire entre heure de la demande et heure du traitement
        TpsHeureTraitement = (HeureRefFin - HeureTraitement) + (HeureDemande - HeureRefDeb)
        If DateDemande = DateTraitement Then TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
        
        If TpsHeureTraitement >= (18 * Heures) Then
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
        End If
        
        'on considère que le 1er et dernier jour sont des jours ouvrés
        For i = DateDemande + 1 To DateTraitement - 1
            If CStr(Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
                Call VerifFerié(i, Férié)
                'si on a un jour férié, on le retranche
                NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
            End If
        Next
        'on vérifie si 1er et dernier jour sont des jours ouvrés
        If Not CStr(Application.WorksheetFunction.Weekday(DateDemande)) Like ("[2-6]") Then FlagNonOuvré = 1
        If Not CStr(Application.WorksheetFunction.Weekday(DateTraitement)) Like ("[2-6]") Then FlagNonOuvré = 1
        Call VerifFerié(DateDemande, Férié)
        If Férié = True Then FlagNonOuvré = 1
        Call VerifFerié(DateTraitement, Férié)
        If Férié = True Then FlagNonOuvré = 1
        
        NbJoursOuvrés = NbJoursOuvrés + Int((24 * TpsHeureTraitement) / 9)
        If TpsHeureTraitement >= (9 * Heures) Then
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * (NbreJrs + 1))
        End If
        délaiH = Format(TpsHeureTraitement, "hh:mm")
        
        'MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
        'Cellule_Result = NbJoursOuvrés & " jours " & délaiH
        Cellule_Result = CStr((NbJoursOuvrés * 9 + Hour(délaiH))) & ":" & CStr(Minute(délaiH))
        If FlagNonOuvré = 0 Then
            Range("E" & p) = Cellule_Result
            Range("E" & p).NumberFormat = "[h]:mm"
        Else
            Range("E" & p) = "Date début ou fin : jour non ouvré !"
        End If
        NbJoursOuvrés = 0
        délaiH = 0
        FlagNonOuvré = 0
    Next p
End Sub

Sub VerifFerié(DateAtraiter, Férié)
    JourFérié = Array("01/01/2008", "24/03/2008") ' etc
    For n = 0 To UBound(JourFérié)
        Férié = DateAtraiter = DateValue(JourFérié(n)) ''si vrai, Férié = -1
        If Férié Then Exit For
    Next
End Sub

à plus

**kenobyalex** · 28/04/2008, 15h06

Je te remercie grandement du temps que tu as consacré à mon problème, ça fonctionne très bien.

Merci encore.

Calcul d'heures ouvrées

Macros et VBA Excel

Discussions similaires

Partager

Partager