Veel mensen zijn op zoek naar een formule die een eerstvolgende werkdag aangeeft op basis van een datum en daarbij rekening houdt met weekends en feestdagen.
Ik kwam een voorbeeld tegen in VBA alleen gebruikte dit voorbeeld een Access database, ik heb het dus iets verbouwd zodat het een lijst met feestdagen data pakt die je ergens in je Excel parkeert en waar je naar kan verwijzen.
Download het voorbeeld bestand HIER
Om te beginnen voegen we een module toe aan een Excel werkblad, kies ALT-F11 - Invoegen - Module
Copy en Paste de volgende code:
Private Function SkipHolidays(feestRange As Range, _
dtmTemp As Date, intIncrement As Integer) _
As Date
' Weekends en feestdagen zoals aangegeven in de feestrange overslaan.
Dim strCriteria As String
Dim c As Range
On Error GoTo HandleErr
'Ga een datum omhoog of omlaag als de laatste datum van de maand een dag in het weekend is
'Sla feestdagen over en ga net zo lang door totdat je een geldige werkdag krijgt.
Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
If Not feestRange Is Nothing Then
If Len(dtmTemp) > 0 Then
For Each c In feestRange.Cells
If c.Value = dtmTemp Then
dtmTemp = dtmTemp + intIncrement
End If
Next c
End If
End If
Loop Until Not IsWeekend(dtmTemp)
ExitHere:
SkipHolidays = dtmTemp
Exit Function
HandleErr:
' Ergens een fout gevonden...
Resume ExitHere
End Function
Function EerstVolgendeWerkdag(Optional dtmDate As Date = 0, _
Optional feestRange As Range) As Date
' Geef de eerstvolgende werkdag na de opgegeven datum
Dim dtmTemp As Date
If dtmDate = 0 Then
'Datum als parameter meegegeven? Deze gebruiken en anders huidige datum pakken
dtmDate = Date
End If
EerstVolgendeWerkdag = SkipHolidays(feestRange, dtmDate + 1, 1)
End Function
Function EerstVorigeWerkdag(Optional dtmDate As Date = 0, _
Optional feestRange As Range) As Date
' Geef de eerstvorige werkdag na de opgegeven datum
Dim dtmTemp As Date
If dtmDate = 0 Then
'Datum als parameter meegegeven? Deze gebruiken en anders huidige datum pakken
dtmDate = Date
End If
EerstVorigeWerkdag = SkipHolidays(feestRange, dtmDate - 1, -1)
End Function
Private Function IsWeekend(dtmTemp As Date) As Boolean
' If your weekends aren't Saturday (day 7)
' and Sunday (day 1), change this routine
' to return True for whatever days
' you DO treat as weekend days.
Select Case Weekday(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End Function
De VBA code heeft 2 publieke Functies: EerstVolgendeWerkdag en EerstVorigeWerkdag (Excuseer de naam ;) ).
Private Functions kun je niet aanroepen vanuit Excel maar als er voor een Function 'Public' staat of er staat gewoon Function dan betekent dit dat je die functies / formules vanuit Excel aan kan roepen als iedere andere formule.
Het rekenwerk wordt gedaan in de formule SkipHolidays, we sturen een datum mee waarmee we willen rekenen en een range die verwijst naar een lijstje met feestdagen.
SkipHolidays kijkt of de eerstvolgende datum in het weekend valt, is dat het geval dan hoogt hij een tellertje op net zo lang tot de datum niet in het weekend valt (Do While IsWeekend(dtmTemp))
Daarna gaat hij o.b.v. de feestrange kijken of de datum die we nu hebben een feestdag is en hoogte de datum weer op als dat het geval is. De formule checkt nog een keer of we nu een datum hebben die in het weekend valt en hoogte deze weer op als dat het geval is.
Theoretisch gezien zou de datum die we nu weer over houden ook weer een feestdag kunnen zijn ;)