Trage Functie(s) voor eerstvolgende werkdag

[wiebeww]

Goedemiddag,

Met enig speurwerk heb ik een aantal handige functies gevonden, echter merk ik dat deze nogal wat vragen van Excel.

Met de functie

=EerstVolgendeWerkdag(C16;Holidays!B2:B49)

kijk ik wat van de datum in C16 de eerstvolgende werkdag is, echter gebruik ik dit voor meerdere velden en zorgt dit voor veel vertraging in mijn bestand.
Op tabblad Holidays (range B2:B49) staan de dagen die aanvullend zijn op de weekenden, zodoende kom ik tot de correcte eerstvolgende werkdag.

Nu ben ik geen expert op het gebied van VBA en al helemaal niet op het gebied van functies, maar wellicht ziet iemand die er wel goed in is nog een aantal 'Quick Wins':

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 TweeVolgendeWerkdag(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
    TweeVolgendeWerkdag = SkipHolidays(feestRange, dtmDate + 2, 2)
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

Bron: http://www.onlineexcelcursus.nl/hom...ag-rekening-houdend-met-weekend-en-feestdagen

 

[VenA]

ipv de bron had je beter jouw bestandje bij kunnen voegen. Welke versie van Xl gebruik je? Vanaf XL-2010? kan je ook

=NETWORKDAYS.INTL()

gebruiken.