vrijdag, 12 juli 2013 18:55

Formule voor eerstvolgende werkdag rekening houdend met weekend en feestdagen

Geschreven door
Beoordeel dit item
(2 stemmen)

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

Zoek de eerstvolgende werkdag

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 ;)

 
 

Aanvullende informatie

  • Versies: Alle versies
Lees 8681 keer Laatst aangepast op vrijdag, 12 juli 2013 19:24
Log in om reacties te plaatsen

Excel Software Shop

Web Analytics