Feiertage und Ostern mit Excel berechnen

' Aufzählung für Feiertage

Public Enum Feiertage

    ftNeujahr = 1

    ftErscheinungsfest = 2

    ftKarfreitag = 3

    ftOstersonntag = 4

    ftOstermontag = 5

    ftMaifeiertag = 6

    ftChristiHimmelfahrt = 7

    ftPfingstmontag = 8

    ftFronleichnam = 9

    ftMariaeHimmelfahrt = 10

    ftTagDerEinheit = 11

    ftReformationstag = 12

    ftAllerheiligen = 13

    ftBussUndBettag = 14

    ftWeihnachtsfeiertag1 = 15

    ftWeihnachtsfeiertag2 = 16

End Enum

Public Function Feiertagsdatum(ByVal Feiertag As Feiertage, Optional ByVal Jahr As Long) As Date

    ' Gibt das Datum eines datumsfesten oder beweglichen Feiertags zurück.

    ' Wurde kein Jahr angegeben, wird das aktuelle Jahr verwendet:

    If Jahr = 0 Then

        Jahr = Year(Now)

    End If

    ' Feiertage ermitteln:

    Select Case Feiertag

        Case ftNeujahr

            Feiertagsdatum = DateSerial(Jahr, 1, 1)

        Case ftErscheinungsfest

            Feiertagsdatum = DateSerial(Jahr, 1, 6)

        Case ftKarfreitag

            Feiertagsdatum = DateAdd("d", -2, Ostersonntag(Jahr))

        Case ftOstersonntag

            Feiertagsdatum = Ostersonntag(Jahr)

        Case ftOstermontag

            Feiertagsdatum = DateAdd("d", 1, Ostersonntag(Jahr))

        Case ftMaifeiertag

            Feiertagsdatum = DateSerial(Jahr, 5, 1)

        Case ftChristiHimmelfahrt

            Feiertagsdatum = DateAdd("d", 39, Ostersonntag(Jahr))

        Case ftPfingstmontag

            Feiertagsdatum = DateAdd("d", 50, Ostersonntag(Jahr))

        Case ftFronleichnam

            Feiertagsdatum = DateAdd("d", 60, Ostersonntag(Jahr))

        Case ftMariaeHimmelfahrt

            Feiertagsdatum = DateSerial(Jahr, 8, 15)

        Case ftTagDerEinheit

            Feiertagsdatum = DateSerial(Jahr, 10, 3)

        Case ftReformationstag

            Feiertagsdatum = DateSerial(Jahr, 10, 31)

        Case ftAllerheiligen

            Feiertagsdatum = DateSerial(Jahr, 11, 1)

        Case ftBussUndBettag

            Feiertagsdatum = DateSerial(Jahr, 12, 25) - Weekday(DateSerial(Jahr, 12, 25), vbMonday) - 4 * 7 - vbWednesday

        Case ftWeihnachtsfeiertag1

            Feiertagsdatum = DateSerial(Jahr, 12, 25)

        Case ftWeihnachtsfeiertag2

            Feiertagsdatum = DateSerial(Jahr, 12, 26)

    End Select

End Function

Public Function Ostersonntag(Optional ByVal Jahr As Long) As Date

    ' Osterfunktion nach Carl Friedrich Gauß (1800). Rückgabewert

    ' ist das Datum des Ostersonntags im angegebenen (ersatzweise:

    ' aktuellen) Jahr. Gültigkeitsbereich: 1583 - 8702 (auf das

    ' Auslösen von Laufzeitfehlern bei Unter- oder Überschreitung

    ' dieses Gültigkeitsbereichs wird hier verzichtet)

    Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long

    ' Wurde kein Jahr angegeben, wird das aktuelle Jahr verwendet:

    If Jahr = 0 Then

        Jahr = Year(Now)

    End If

    ' Die "magische" Gauss-Formel anwenden:

    a = Jahr Mod 19

    b = Jahr \ 100

    c = (8 * b + 13) \ 25 - 2

    d = b - (Jahr \ 400) - 2

    e = (19 * (Jahr Mod 19) + ((15 - c + d) Mod 30)) Mod 30

    If e = 28 Then

        If a > 10 Then

            e = 27

        End If

    ElseIf e = 29 Then

        e = 28

    End If

    f = (d + 6 * e + 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6) Mod 7

    ' Rückgabewert als Datum bereitstellen

    Ostersonntag = DateSerial(Jahr, 3, e + f + 22)

End Function

Feiertagsdatum = DateSerial(Jahr, 12, 25) - Weekday(DateSerial(Jahr, 12, 25), vbMonday) - 4 * 7 - vbWednesday