Bereken verschillende datums met deze VBA functie

Met deze handige functie kun je vanuit een input datum de volgende soorten datums laten berekenen:

1. eerste dag van het kwartaal
2. laatste dag van het kwartaal
3. eerste werkdag van het kwartaal
4. laatste werkdag van het kwartaal
5. eerste dag v/d maand
6. laatste dag v/d maand
7. eerste werkdag v/d maand
8. laatste werkdag v/d maand
9. eerste dag van het jaar
10. laatste dag van het jaar
11. eerste werkdag van het jaar
12. laatste werkdag van het jaar

Als je kiest voor een werkdag dan houdt deze functie rekening met zowel weekend dagen als vakantiedagen!

Public Function DatumBepaling(InputDatum As Date, TypeOutputDatum As Integer) As Date
    '##########################################opties
    '#### 1 = eerste dag van het kwartaal
    '#### 2 = laatste dag van het kwartaal
    '#### 3 = eerste werkdag van het kwartaal
    '#### 4 = laatste werkdag van het kwartaal
    '#### 5 = eerste dag v/d maand
    '#### 6 = laatste dag v/d maand
    '#### 7 = eerste werkdag v/d maand
    '#### 8 = laatste werkdag v/d maand
    '#### 9 = eerste dag van het jaar
    '#### 10 = laatste dag van het jaar
    '#### 11 = eerste werkdag van het jaar
    '#### 12 = laatste werkdag van het jaar
    '###########################################
    
    Dim goedevrijdag As Date
    Dim hemelvaartsdag As Date
    Dim paasMaandag As Date
    Dim pinksterMaandag As Date
       
    If TypeOutputDatum = 1 Then
        DatumBepaling = DateSerial(Year(InputDatum), Int((Month(InputDatum) - 1) / 3) * 3 + 1, 1)
    ElseIf TypeOutputDatum = 2 Then
        DatumBepaling = DateSerial(Year(InputDatum), Int((Month(InputDatum) - 1) / 3) * 3 + 4, 0)
    ElseIf TypeOutputDatum = 3 Then
        WerkdagLoop = "ja"
        DatumBepaling = DateSerial(Year(InputDatum), Int((Month(InputDatum) - 1) / 3) * 3 + 1, 1)
    ElseIf TypeOutputDatum = 4 Then
        WerkdagLoop = "ja"
    ElseIf TypeOutputDatum = 5 Then
        DatumBepaling = DateSerial(Year(InputDatum), Month(InputDatum), 1)
    ElseIf TypeOutputDatum = 6 Then
        DatumBepaling = DateSerial(Year(InputDatum), Month(InputDatum) + 1, 0)
    ElseIf TypeOutputDatum = 7 Then
        WerkdagLoop = "ja"
        DatumBepaling = DateSerial(Year(InputDatum), Month(InputDatum), 1)
    ElseIf TypeOutputDatum = 8 Then
        WerkdagLoop = "ja"
        DatumBepaling = DateSerial(Year(InputDatum), Month(InputDatum) + 1, 0)
    ElseIf TypeOutputDatum = 9 Then
        DatumBepaling = DateSerial(Year(InputDatum), 1, 1)
    ElseIf TypeOutputDatum = 10 Then
        DatumBepaling = DateSerial(Year(InputDatum), 13, 0)
    ElseIf TypeOutputDatum = 11 Then
        WerkdagLoop = "ja"
        DatumBepaling = DateSerial(Year(InputDatum), 1, 1)
    ElseIf TypeOutputDatum = 12 Then
        WerkdagLoop = "ja"
        DatumBepaling = DateSerial(Year(InputDatum), 13, 0)
    End If
    
    If WerkdagLoop = "ja" Then
        Do Until datum = "werkdag"
            If Format(DatumBepaling, "w") <> 7 And Format(DatumBepaling, "w") <> 1 Then
                jaar = Year(InputDatum)
                a = DateSerial(jaar, 4, 1) / 7
                If jaar Mod 19 = 0 Then
                b = 19
                End If
                c = (jaar Mod 19 + b) * 19 - 7
                d = (c Mod 30) / 7
                Pasen = Round(a + d, 0) * 7 - 6
                
                nieuwjaarsdag = DateSerial(jaar, 1, 1)
                goedevrijdag = Pasen - 2
                paasMaandag = Pasen + 1
                koningsdag = DateSerial(jaar, 4, 27)
                DagArbeid = DateSerial(jaar, 5, 1)
                bevrijdingsdag = DateSerial(jaar, 5, 5)
                hemelvaartsdag = Pasen + 39
                pinksterMaandag = Pasen + 50
                eersteKerstdag = DateSerial(jaar, 12, 25)
                tweedeKerstdag = DateSerial(jaar, 12, 26)
                
                If DatumBepaling <> nieuwjaarsdag And DatumBepaling <> goedevrijdag And DatumBepaling <> paasMaandag And DatumBepaling <> koningsdag And DatumBepaling <> DagArbeid And _
                DatumBepaling <> bevrijdingsdag And DatumBepaling <> hemelvaartsdag And DatumBepaling <> pinksterMaandag And DatumBepaling <> pinksterMaandag And DatumBepaling <> _
                eersteKerstdag And DatumBepaling <> tweedeKerstdag Then
                    datum = "werkdag"
                Else
                    If TypeOutputDatum = 3 Or TypeOutputDatum = 7 Or TypeOutputDatum = 11 Then
                        DatumBepaling = DatumBepaling + 1
                    Else
                        DatumBepaling = DatumBepaling - 1
                    End If
                End If
            Else
                If TypeOutputDatum = 3 Or TypeOutputDatum = 7 Or TypeOutputDatum = 11 Then
                    DatumBepaling = DatumBepaling + 1
                Else
                    DatumBepaling = DatumBepaling - 1
                End If
            End If
        Loop
    End If
    
End Function

Je kunt de bovenstaande functie op de volgende manier aanroepen:

outputdatum = DatumBepaling("3-1-2023", 7)

Zelf vind ik het echter prettig om in geval van datums altijd de Dateserial functie te gebruiken. Zo kan er namelijk geen twijfel over bestaan dat jouw input als datum wordt gezien. 

outputdatum = DatumBepaling(DateSerial(2023, 1, 3), 3)

Ik hoop dat jullie iets aan deze functie hebben. Mocht het zo zijn dat je alleen wilt weten hoe je bijvoorbeeld vanuit een datum een laatste dag van een kwartaal berekend. Dan kun je deze specifieke berekening uit de IF statement halen onder nummer 2.

Heb je een suggestie om deze functie te verbeteren? Laat het weten in de comments!