Jours ouvrés entre deux dates
Nombre de jours ouvrés entre deux dates
Cette fonction retourne le nombre de jours ouvrés entre deux dates renseignées.
Dans l'état, elle retourne les jours ouvrés pour la France, mais peut être facilement adapté - voir fnHolidays() - à d'autres pays ou conditions.
=> Vous avez également besoin des fonctions fnHolidays() et fnEaster() ci-dessous.
Utilisation :
X = fnWorkDays("1/1/2019", "31/12/2019")
ou plus souvent :
x = fnWorkDays([champ1], [champ2])
Public Function fnWorkDays(Date1, Date2) As Integer ' Renvoi le nombre de jours ouvrés ' Utilise la fonction fnHolidays() et fnEaster() Dim StartDate As Date, EndDate As Date, TestDate As Date Dim DayCounter As Integer If Not (IsDate(Date1) And IsDate(Date2)) Then Exit Function Else StartDate = Date1: EndDate = Date2 End If TestDate = StartDate DayCounter = 0 Do Until TestDate > EndDate If (Weekday(TestDate) <> 6) And (Weekday(TestDate) <> 7) _ And (fnHolidays(TestDate) = False) Then DayCounter = DayCounter + 1 End If TestDate = DateAdd("d", 1, TestDate) Loop fnWorkDays = DayCounter End Function
Public Function fnHolidays(CurDate As Date) As Boolean Dim dPaques As Date, dLPaques As Date dPaques = fnEaster(Year(CurDate)) dLPaques = DateAdd("d", 1, dPaques) Select Case CurDate Case CDate("01/01/" & Year(CurDate)) 'Jour de l'an fnHolidays = True Case dLPaques 'Lundi de Pâques fnHolidays = True Case CDate("01/05/" & Year(CurDate)) 'Fête du travail fnHolidays = True Case CDate("08/05/" & Year(CurDate)) 'Victoire de 1945 fnHolidays = True Case CDate("30/05/" & Year(CurDate)) 'Ascension fnHolidays = True Case dPaques + 50 'Lundi de pentcôte fnHolidays = True Case CDate("14/07/" & Year(CurDate)) 'Fête nationale fnHolidays = True Case CDate("15/08/" & Year(CurDate)) 'Assomption fnHolidays = True Case CDate("01/11/" & Year(CurDate)) 'Toussaint fnHolidays = True Case CDate("11/11/" & Year(CurDate)) 'Armistie 1918 fnHolidays = True Case CDate("25/12/" & Year(CurDate)) 'Noël fnHolidays = True '/ Vous pouvez adapter selon vos besoins '/ - soit en ajoutant 2 lignes selon le modèle '/ - soit en commentant les 2 lignes non utiles Case Else fnHolidays = False End Select End Function
Public Function fnEaster(wAn%) As Date 'Pâques est le dimanche qui suit le quatorzième jour de la 'Lune qui tombe le 21 mars ou immédiatement après Dim wA%, wB%, wC%, wD%, wE%, wF%, wG%, wH% Dim wI%, wJ%, wK%, wL%, wM%, wN%, wP% wA = wAn Mod 19 'Calcul du rang de l'année dans le cycle lunaire qui a 19 ans wB = wAn / 100 'Calcul du siècle wC = wAn Mod 100 'Calcul du rang de l'année dans le siècle wD = wB / 4 wE = wB Mod 4 wF = (wB + 8) / 25 wG = (wB - wF + 1) / 3 wH = (19 * wA + wB - wD - wG + 15) Mod 30 wI = wC / 4 wK = wC Mod 4 wL = (32 + 2 * wE + 2 * wI - wH - wK) Mod 7 wM = (wA + 11 * wH + 22 * wL) / 451 wN = (wH + wL - 7 * wM + 114) / 31 'détermine le mois wP = (wH + wL - 7 * wM + 114) Mod 31 'détermine le jour fnEaster = DateSerial(wAn, wN, wP + 1) End Function
Catégorie : Les mémos - Dates - Heures
Page lue 1849 fois