difference en jours ouvrés entre 2 dates

**chrisaccess** · 01/10/2012, 01h16

bonjour,

Je cherche à réaliser une différence entre 2 dates stockes dans une variable afin d'appliquer une mise en forme à une ligne.
La fonction datediff remplit à ce jour cette fonction dans mon programme. Mais je cherche à l'amélioreren faisant une différence en jours ouvrés

j'ai trouvé ce code de Michelg dans une discussion de debut d'année:

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
73
74
75
76
77
Function Work_Days(BegDate As Variant, EndDate As Variant, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim dt As Date
 
On Error GoTo Work_Days_Error
    If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
    If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
    If BegDate > EndDate Then Err.Raise vbObjectError + 3
 
    dt = BegDate
    Work_Days = 0
    While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
            Work_Days = Work_Days + 1
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = Err.description
    End Select
End Function
 
 
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim i As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
 
  joursFeries(9) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        ' Lundi de Pâques = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

Si je comprends l'ensemble du code, j'ai un peu plus de mal avec cette partie :

Code :

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

1
2
3
4
While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
            Work_Days = Work_Days + 1
        End If

Pour voir son effet j'éxécute en parallèle cette fonction dans mon code avec datediff et j'affiche une comparaison avec msgbox
C'est là qu je m'aperçois que le résultat de cette fonction me donne 1 ou 0

Quelqu'un pourrais t il m'expliquer et me dire comment modifier pour avoir le nombre de jours ouvrés entre 2 dates?

Merci d'avance

**kiki29** · 01/10/2012, 06h24

Salut, voir ici

**chrisaccess** · 04/10/2012, 22h06

Salut;

Génial, elles sont plus compréhensible.
Je m"y concentre ce soir dessus et te faisun retour.

a+

bonsoir,

Excellente discussion, j'ai retenu pour ma part ce code, pour sa simplicité :

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
Sub NbreJourOuvres()
Dim DateDebut As Date
Dim DateFin As Date
    DateDebut = CDbl(DateValue("03/04/2007"))
    DateFin = CDbl(DateValue("03/05/2007"))
    MsgBox NBJoursOuvres(DateDebut, DateFin)
End Sub
 
Function NBJoursOuvres(DateDebut, DateFin)
Dim i As Long
    For i = DateDebut To DateFin
        If Weekday(CDate(i)) <> 1 And Weekday(CDate(i)) <> 7 Then _
            NBJoursOuvres = NBJoursOuvres + 1
    Next
End Function