Berechnung beweglicher Feiertage unter Visual Basic

Feiertage wie Ostern fallen nicht auf ein spezielles Datum. Eine Formel gibt zurück, ob es sich bei einem Datum um einen Feiertag handelt.

Feiertage wie Ostern fallen nicht auf ein spezielles Datum. Die meisten beweglichen Feiertage haben einen definierten zeitlichen Abstand vom Ostersonntag, nur der in Sachsen noch gültige Buß- und Bettag definiert sich als der Mittwoch vor dem Sonntag vor dem 1. Advent.

Die folgende Übersicht zeigt die Datenzusammenhänge und die Gültigkeit der entsprechenden Feiertage nach Bundesländern aufgeschlüsselt:

Die Abhängigkeit der beweglichen Feiertage vom Ostersonntag ist vergleichsweise simpel - die Addition eines Intervalls zu einem Datum wird unter Visual Basic mithilfe der Funktion DateAdd vorgenommen. Da jedoch auch der Ostersonntag nicht datumsfest ist, muss zunächst dessen Datum in einem Jahr errechnet werden.
Ostern fällt auf den ersten Sonntag nach dem ersten Frühlingsvollmond. Für Nichtastronomen lässt sich dieser Sonntag glücklicherweise auch nach der so genannten Osterformel von Carl Friedrich Gauß berechnen, die dieser im Jahr 1800 aufstellte. Die folgende Funktion Ostersonntag liefert auf Basis dieser Formel das Datum des Ostersonntags in einem angegebenen Jahr:

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 absichtlich 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

Wäre der "Buß- und Bettag", der im Jahr 1995 in den meisten Bundesländern zwecks Finanzierung der Pflegeversicherung weichen musste, nicht im Bundesland Sachsen noch ein Feiertag, wären wir hier bereits an unserem Ziel angelangt. So aber müssen wir auch die Berechnung des Buß- und Bettags berücksichtigen: Er fällt auf den Mittwoch vor dem Sonntag vor dem ersten Adventssonntag. Offensichtlich ist, dass der erste Adventssonntag drei Wochen vor dem vierten Adventssonntag liegt. Der vierte Adventssonntag wiederum ist der Sonntag vor dem 25. Dezember eines Jahres. In entsprechendem Sourcecode formuliert:

Dim BussUndBettag As Date 
Dim Jahr As Long
  
  Jahr = Year(Now)
  BussUndBettag= DateSerial(Jahr, 12, 25) - _
                 WeekDay(DateSerial(Jahr, 12, 25), vbMonday) _
                 - 4 * 7 - vbWednesday

Die folgenden Routinen stellen Ihnen Feiertagsinformationen zur Verfügung, die auch die Unterschiede zwischen den deutschen Bundesländern berücksichtigen.

Die Funktion Ostersonntag liefert Ihnen - wenig überraschend - das Datum des Ostersonntags eines Jahres zurück.Die Funktion Feiertagsdatum nutzt diese Funktion, um die Daten von Feiertagen in einem angegebenen Jahr zurückzugeben. Mithilfe der Funktion IstFeiertagIn können Sie feststellen, ob ein Feiertag in einem bestimmten Bundesland begangen wird (in einem Bundesland uneinheitlich behandelte Feiertage werden dabei als nicht begangen gewertet - beachten Sie hierzu bitte die Kommentare im Sourcecode der Funktion). Letztlich dient die Funktion Bundeslandsname Ihrer Bequemlichkeit bei der Ausgabe von Bundesländernamen auf Basis der Aufzählung Bundeslaender.

' 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
  
' Aufzählung für Bundesländer
Public Enum Bundeslaender
  blBadenWuerttemberg = 2 ^ 0
  blBayern = 2 ^ 1
  blBerlin = 2 ^ 2
  blBrandenburg = 2 ^ 3
  blBremen = 2 ^ 4
  blHamburg = 2 ^ 5
  blHessen = 2 ^ 6
  blMecklenburgVorpommern = 2 ^ 7
  blNiedersachsen = 2 ^ 8
  blNordrheinWestfalen = 2 ^ 9
  blRheinlandPfalz = 2 ^ 10
  blSaarland = 2 ^ 11
  blSachsen = 2 ^ 12
  blSachsenAnhalt = 2 ^ 13
  blSchleswigHolstein = 2 ^ 14
  blThueringen = 2 ^ 15
End Enum
  
  
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
  
  
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 Bundeslandname(ByVal Bundesland As Bundeslaender) As String
' Service-Funktion für AUsgabezwecke: Liefert zu einem Wert der Aufzählung
' "Bundeslaender" den Klartextnamen des durch den Wert repräsentierten
' Bundeslandes zurück.
  
  Select Case Bundesland
    Case blBadenWuerttemberg:     Bundeslandname = "Baden-Württemberg"
    Case blBayern:                Bundeslandname = "Bayern"
    Case blBerlin:                Bundeslandname = "Berlin"
    Case blBrandenburg:           Bundeslandname = "Brandenburg"
    Case blBremen:                Bundeslandname = "Bremen"
    Case blHamburg:               Bundeslandname = "Hamburg"
    Case blHessen:                Bundeslandname = "Hessen"
    Case blMecklenburgVorpommern: Bundeslandname = "Mecklenburg-Vorpommern"
    Case blNiedersachsen:         Bundeslandname = "Niedersachsen"
    Case blNordrheinWestfalen:    Bundeslandname = "Nordrhein-Westfalen"
    Case blRheinlandPfalz:        Bundeslandname = "Rheinland-Pfalz"
    Case blSaarland:              Bundeslandname = "Saarland"
    Case blSachsen:               Bundeslandname = "Sachsen"
    Case blSachsenAnhalt:         Bundeslandname = "Sachsen-Anhalt"
    Case blSchleswigHolstein:     Bundeslandname = "Schleswig-Holstein"
    Case blThueringen:            Bundeslandname = "Thüringen"
  End Select
  
End Function
  
  
Public Function IstFeiertagIn(ByVal Feiertag As Feiertage, _
                              Optional ByVal Bundesland As Bundeslaender = 0 _
                              ) As Boolean
' Gibt zurück, ob der im Parameter Feiertag angegebene Feiertag in
' einem angegebenen Bundesland begangen wird (True) oder nicht (False).
' Wird für den Parameter Bundesland kein Wert übergeben, wird zurückgegeben,
' ob der Feiertag ein bundesweit einheitlicher Feiertag ist.
'
' HINWEIS: Feiertage, die nur in einzelnen Gemeinden eines Bundeslandes
'          begangen werden (Fronleichnam: Sachsen, Thüringen; Mariä
'          Himmelfahrt: Bayern), werden von dieser Funktion als in diesen
'          Bundesländern als NICHT begangen behandelt! Hinweise, wie Sie
'          dieses Verhalten bei Bedarf ändern können, finden Sie in diesem
'          Sourcecode.
'
' TIPP:    Bei Übergabe durch den Or- oder +-Operator kumulierter Werte
'          für den Parameter Bundesland können Sie feststellen, ob dieser
'          Feiertag in mehreren Bundesländern begangen wird. Beispiel:
'          IstFeiertagInBayernUndInHessen = _
'            IstFeiertagIn(ftFronleichnam, ftBayern + ftHessen)
  
  ' Bundesweit einheitliche Feiertage
  Select Case Feiertag
  
    Case ftNeujahr, ftKarfreitag, ftOstersonntag, ftOstermontag, _
         ftMaifeiertag, ftChristiHimmelfahrt, ftPfingstmontag, _
         ftTagDerEinheit, ftWeihnachtsfeiertag1, ftWeihnachtsfeiertag2
      IstFeiertagIn = True
      
  End Select
  
  ' Wurde kein Wert für Bundesland übergeben, wird die Funktion hier 
Erlassen
  If Bundesland = 0 Then
    Exit Function
  End If
  
  ' Bundesweit nicht einheitliche Feiertage
  Select Case Feiertag
    
    Case ftErscheinungsfest
      IstFeiertagIn = (Bundesland And ( _
                       blBadenWuerttemberg Or blBayern Or blSachsenAnhalt) 

                      ) = Bundesland
  
    Case ftFronleichnam
      ' HINWEIS: In Sachsen-Anhalt und Thüringen wird Fronleichnam
      ' nur vereinzelt als Feiertag begangen. Für diese Bundesländer
      ' liefert diese Funktion generell FALSE zurück. Ändern Sie
      ' dieses Verhalten bei Bedarf in diesem Select Case-Zweig.
      IstFeiertagIn = (Bundesland And ( _
                       blBadenWuerttemberg Or blBayern Or blHessen Or _
                       blNordrheinWestfalen Or blRheinlandPfalz Or blSaarland) _
                      ) = Bundesland
  
    Case ftMariaeHimmelfahrt
      ' HINWEIS: In Bayern wird Mariä Himmelfahrt nur in einzelnen
      ' Gemeinden als Feiertag begangen. Für dieses Bundesland
      ' liefert diese Funktion generell FALSE zurück. Ändern Sie
      ' dieses Verhalten bei Bedarf in diesem Select Case-Zweig.
      IstFeiertagIn = (Bundesland And ( _
                       blSaarland) _
                      ) = Bundesland
  
    Case ftReformationstag
      IstFeiertagIn = (Bundesland And ( _
                       blBrandenburg Or blMecklenburgVorpommern Or 
lSachsen _
                       Or blSachsenAnhalt Or blThueringen) _
                      ) = Bundesland
  
    Case ftAllerheiligen
      IstFeiertagIn = (Bundesland And ( _
                       blBadenWuerttemberg Or blBayern Or blNordrheinWestfalen _
                       Or blRheinlandPfalz Or blSaarland) _
                      ) = Bundesland
    
     Case ftBussUndBettag
      IstFeiertagIn = (Bundesland And ( _
                       blSachsen) _
                      ) = Bundesland
  
   End Select
  
End Function