SmartFAQ is developed by The SmartFactory (http://www.smartfactory.ca), a division of InBox Solutions (http://www.inboxsolutions.net)

[VBA] Une fonction pour calculer le nombre de jours ouvrés (hors jours fériés, samedis et dimanches) entre 2 dates ?

Q&R publiée par MyDearFriend! le 26-08-2008 (8111 Lectures)
Voici une fonction personnalisée qui permet d'obtenir le nombre de jours ouvrés existant entre 2 dates (hors jours fériés français, samedis et dimanches).

Cette fonction peut être utilisée soit dans votre propre code VBA, soit directement dans une feuille Excel.

DANS UN MODULE DE CODE STANDARD
Option Explicit

Function NbJoursOuvres(D1 As Date, D2 As Date) As Long
'myDearFriend! - www.mdf-xlpages.com
Dim DF As New Collection
Dim D As Date
Dim
NbJO As Long
Dim
An As Integer
Dim
Ok As Boolean
    Application.Volatile
    On Error Resume Next
    For
An = Year(D1) To Year(D2)
        D = DimPaques(An)
        DF.Add DateSerial(An, 1, 1), CStr(DateSerial(An, 1, 1))     'Jour de l'An
        DF.Add D + 1, CStr(D + 1)                                   'Lundi de Pâques
        DF.Add DateSerial(An, 5, 1), CStr(DateSerial(An, 5, 1))     'Fête du Travail
        DF.Add DateSerial(An, 5, 8), CStr(DateSerial(An, 5, 8))     'Armistice 1945
        DF.Add D + 39, CStr(D + 39)                                 'Jeudi Ascension
        DF.Add D + 50, CStr(D + 50)                                 'Lundi de Pentecôte
        DF.Add DateSerial(An, 7, 14), CStr(DateSerial(An, 7, 14))   'Fête Nationale
        DF.Add DateSerial(An, 8, 15), CStr(DateSerial(An, 8, 15))   'Assomption
        DF.Add DateSerial(An, 11, 1), CStr(DateSerial(An, 11, 1))   'Toussaint
        DF.Add DateSerial(An, 11, 11), CStr(DateSerial(An, 11, 11)) 'Armistice 1918
        DF.Add DateSerial(An, 12, 25), CStr(DateSerial(An, 12, 25)) 'Noël
    Next An
    D = D1
    Do
        If
Weekday(D, vbMonday) < 6 Then
            Ok = DF(CStr(D)) <> ""
            If Not Ok Then NbJO = NbJO + 1
            Ok = False
        End If

        D = D + 1
    Loop Until D > D2
    NbJoursOuvres = NbJO
End Function

Private Function DimPaques(ByVal Annee As Integer) As Date
'myDearFriend! - www.mdf-xlpages.com
'(Calcul du dimanche de Pâques d'après un algorithme de Thomas O'Beirne)
Dim n As Integer, c As Integer, a As Byte, b As Byte
    n = Annee - 1900
    a = n Mod 19
    b = (11 * a + 4 - ((a * 7 + 1) \ 19)) Mod 29
    c = 25 - b - ((n - b + 31 + (n \ 4)) Mod 7)
    DimPaques = DateAdd("d", c, DateSerial(Annee, 3, 31))
End Function


Pour l'utiliser directement dans une feuille de calcul :
Soit une date de DEBUT en A1 et une date de FIN en B1, vous obtiendrez le nombre de jours ouvrés de la période en saisissant simplement la formule suivante dans une cellule quelconque de la feuille :
=NbJoursOuvres(A1;B1)

  Imprimer la Q&R Envoyer la Q&R