VBA macro berekening aantal werkdagen, feestdagen tussen twee datums

[e***@planet.nl]

Voor wie het kan gebruiken.

De hier onderstaande code kun je toevoegen aan een VBA module.
De code bepaald of een dag een werk, zaterdag/zondag, of feestdag is.
De berekening houdt rekening met nederlandse feestdagen.
De code is denk ik helder genoeg om eventueel te kunnen worden
aangepast voor andere doeleinden.

Verder kan de code het aantal werkdagen berekenen tussen twee datums.

De code bevat ook een functie die berekend op welke dag in een jaar
het pasen is. Hemelvaart en Pinksteren zijn daarvan af te leiden (zie
code).
Let even op de drie constantes boven in de code.
Deze kunnen soms per bedrijf afwijken.

Hieronder de code:
**************************************************************
Option Explicit

Const C_30_APRIL_IS_WERKDAG As Boolean = True
Const C_5_MEI_IS_WERKDAG As Boolean = True
Const C_31_DECEMBER_IS_WERKDAG As Boolean = False
'

Public Function AantalWerkdagen(StartDate, EndDate) As Long
Dim d As Date
Dim cnt As Long

' Onthoud 1e paasdag indien mogelijk, maakt berekening veel sneller
Dim oldEerstePaasdag As Date
Dim oldJaar As Long

On Error GoTo errh

If Not (IsNull(StartDate) Or IsNull(EndDate)) Then
' initialisatie
oldEerstePaasdag = 0
oldJaar = 0

cnt = 0
For d = StartDate To EndDate
' Is normale dag van de week
If Weekday(d, vbMonday) < 6 Then
If Not IsFeestdag(d, oldEerstePaasdag, oldJaar) Then
cnt = cnt + 1
End If
End If
Next d

AantalWerkdagen = cnt
Else
AantalWerkdagen = 0
End If

Exit Function
errh:
If Err.Number > 0 Then
AantalWerkdagen = 0
End If
End Function

Public Function IsWerkDag(d As Date) As Boolean
Dim oldEerstePaasdag As Date
Dim oldJaar As Long

oldEerstePaasdag = 0
oldJaar = 0

If Weekday(d, vbMonday) < 6 Then
IsWerkDag = Not IsFeestdag(d, 0, 0)
Else
IsWerkDag = False ' zaterdag of zondag
End If
End Function


'Checklist:
' * Kerst OK
' * Pasen OK
' * Hemelvaart OK
' * Pinksteren OK
' * Nieuwjaar OK
' * Oudjaar OK
' * Koninginnedag 30 April OK
' * Bevrijdingsdag 5 mei OK

Private Function IsFeestdag(d As Date, ByRef oldEerstePaasdag As Date,
ByRef oldJaar As Long) As Boolean
Dim dag As Long, maand As Long, Jaar As Long

dag = DateTime.Day(d)
maand = DateTime.month(d)
Jaar = DateTime.year(d)

' Bereken 1e paasdag alleen indien nodig, vanwege de snelheid!
If (oldJaar <> Jaar) Then
oldJaar = Jaar
oldEerstePaasdag = BerekenEerstePaasdag(oldJaar)
End If

IsFeestdag = False ' initalisatie
Select Case dag
Case 1 ' Januari
If (d = 1) Then ' Nieuwjaar
IsFeestdag = True
End If
'Case 2 ' Februari
' ' geen feestdagen in febrari
' uitgecommentarieerd: maakt functie iets sneller
Case 3 ' Maart
If IsPasen(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsHemelVaart(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsPinksteren(d, oldEerstePaasdag) Then
IsFeestdag = True
End If
Case 4 ' April
If Not C_30_APRIL_IS_WERKDAG Then ' Koninginnedag
If (dag = 30) Then
IsFeestdag = True
End If
ElseIf IsPasen(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsHemelVaart(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsPinksteren(d, oldEerstePaasdag) Then
IsFeestdag = True
End If
Case 5 ' mei
If Not C_5_MEI_IS_WERKDAG Then
If (dag = 5) Then
IsFeestdag = True
End If
ElseIf IsPasen(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsHemelVaart(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsPinksteren(d, oldEerstePaasdag) Then
IsFeestdag = True
End If
Case 6 ' Juni
If IsPasen(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsHemelVaart(d, oldEerstePaasdag) Then
IsFeestdag = True
ElseIf IsPinksteren(d, oldEerstePaasdag) Then
IsFeestdag = True
End If
Case 7 ' Juli
Case 8 ' Augustus
Case 9 ' September
Case 10 ' Oktober
Case 11 ' November
Case 12 ' December
If (d = 25) Or (d = 26) Then ' Kerst
IsFeestdag = True
ElseIf Not C_31_DECEMBER_IS_WERKDAG Then
If (d = 31) Then
IsFeestdag = True
End If
End If
'Case Else
' ' not possible
End Select
End Function

Private Function IsPasen(d As Date, oldEerstePaasdag As Date) As
Boolean
If (d = oldEerstePaasdag) Then
IsPasen = True
ElseIf (d = oldEerstePaasdag + 1) Then
IsPasen = True
Else
IsPasen = False
End If
End Function

Private Function IsHemelVaart(d As Date, oldEerstePaasdag As Date) As
Boolean
Dim HemelvaartsDag As Date
HemelvaartsDag = oldEerstePaasdag + 39

If (d = HemelvaartsDag) Then
IsHemelVaart = True
Else
IsHemelVaart = False
End If
End Function

Private Function IsPinksteren(d As Date, oldEerstePaasdag As Date) As
Boolean
Dim EerstePinksterDag As Date
EerstePinksterDag = oldEerstePaasdag + 49

If (d = EerstePinksterDag) Then
IsPinksteren = True
ElseIf (d = EerstePinksterDag + 1) Then
IsPinksteren = True
Else
IsPinksteren = False
End If
End Function

Public Function BerekenEerstePaasdag(Jaar As Long) As Date
If (Jaar > 1900) And (Jaar < 2100) Then
Dim intDominical As Long, intEpact As Long, intQuote As Long

intDominical = 225 - (11 * (Jaar Mod 19))
While intDominical > 50
intDominical = intDominical - 30
Wend

If intDominical > 48 Then
intDominical = intDominical - 1
End If

intEpact = (Jaar + Int(Jaar / 4) + intDominical + 1) Mod 7
intQuote = intDominical + 7 - intEpact

BerekenEerstePaasdag = DateSerial(Jaar, 3, intQuote)
Else
Err.Raise vbError + 100, "Failed to calculate Easter for " &
Str$(Jaar) & "."
End If
End Function

Public Function Werkdag(d As Date) As String
If IsWerkDag(d) Then
Werkdag = "Ja"
Else
Werkdag = "Nee"
End If
End Function
**************************************************************

[Amedee Van Gasse]

Post by e***@planet.nl
Voor wie het kan gebruiken.
De hier onderstaande code kun je toevoegen aan een VBA module.
De code bepaald of een dag een werk, zaterdag/zondag, of feestdag is.
De berekening houdt rekening met nederlandse feestdagen.
De code is denk ik helder genoeg om eventueel te kunnen worden
aangepast voor andere doeleinden.
Verder kan de code het aantal werkdagen berekenen tussen twee datums.
De code bevat ook een functie die berekend op welke dag in een jaar
het pasen is. Hemelvaart en Pinksteren zijn daarvan af te leiden (zie
code).
Let even op de drie constantes boven in de code.
Deze kunnen soms per bedrijf afwijken.

*snip*

Je code om de paasdatum te berekenen is interessant.
De Nederlandse feestdagen gebruiken wij uiteraard niet.
Verder zal ik persoonlijk wel de ingebouwde functie
=NETTO.WERKDAGEN(begindatum;einddatum;vakantiedagen)
blijven gebruiken.
:)