Wie berechnet man die Feiertage eines Jahres?

Erstellen Sie ein neues Modul und fügen Sie die nachfolgenden Codezeilen ein: 

Option Explicit
'// ----------------------------------------------------------------
'// Feiertagsberechnung nach dem Algorithmus von Carl Friedrich Gauß
'// ----------------------------------------------------------------
Type DtFeiertage
   Jahreszahl As Long
   Ostern As Date
   Neujahr As Date
   DreiKoenige As Date
   Rosenmontag As Date
   Aschermittwoch As Date
   Karfreitag As Date
   Ostersonntag As Date
   Ostermontag As Date
   Maifeiertag As Date
   ChrHimmelfahrt As Date
   Pfingstsonntag As Date
   Pfingstmontag As Date
   Fronleichnam As Date
   MariaeHimmelfahrt As Date
   DtEinheit As Date
   Reformationstag As Date
   Allerheiligen As Date
   Heiligabend As Date
   Weihnachten1 As Date
   Weihnachten2 As Date
   Sylvester As Date
End Type

Dim m_uDTF As DtFeiertage

 

Sub Beispiel()

   Call BerechneFeiertage(Year(Now))
   Debug.Print "Die Feiertage für "; Year(Now); vbCrLf
   Debug.Print "Neujahr "; Format(m_uDTF.Neujahr, "Long Date")
   Debug.Print "Hl. Drei Könige "; Format(m_uDTF.DreiKoenige, _
   "Long Date")
   Debug.Print "Rosenmontag "; Format(m_uDTF.Rosenmontag, _
   "Long Date")
   Debug.Print "Aschermittwoch "; Format(m_uDTF.Aschermittwoch,_
   "Long Date")
   Debug.Print "Karfreitag "; Format(m_uDTF.Karfreitag, _
   "Long Date")
   Debug.Print "Ostersonntag "; Format(m_uDTF.Ostersonntag, _
   "Long Date")
   Debug.Print "Ostermontag "; Format(m_uDTF.Ostermontag, _
   "Long Date")
   Debug.Print "Maifeiertag "; Format(m_uDTF.Maifeiertag, _
   "Long Date")
   Debug.Print "Christi Himmelfahrt "; Format(m_uDTF._
   ChrHimmelfahrt, "Long Date")
   Debug.Print "Pfingstsonntag "; Format(m_uDTF._
   Pfingstsonntag, "Long Date")
   Debug.Print "Pfingstmontag "; Format(m_uDTF.Pfingstmontag, _
   "Long Date")
   Debug.Print "Fronleichnam "; Format(m_uDTF.Fronleichnam, _
   "Long Date")
   Debug.Print "Mariä Himmelfahrt "; Format(m_uDTF._
   MariaeHimmelfahrt, "Long Date")
   Debug.Print "Tag der dt. Einheit "; Format(m_uDTF.DtEinheit, _
   "Long Date")
   Debug.Print "Reformationstag "; Format(m_uDTF._
   Reformationstag, "Long Date")
   Debug.Print "Allerheiligen "; Format(m_uDTF.Allerheiligen, _
   "Long Date")
   Debug.Print "Heiligabend "; Format(m_uDTF.Heiligabend, _
   "Long Date")
   Debug.Print "Weihnachten1 "; Format(m_uDTF.Weihnachten1, _
   "Long Date")
   Debug.Print "Weihnachten2 "; Format(m_uDTF.Weihnachten2, _
   "Long Date")
   Debug.Print "Sylvester "; Format(m_uDTF.Sylvester, _
   "Long Date")
'// ----------------------------------------------------------------
'// Ausgabe:
'// ----------------------------------------------------------------
'// Neujahr Mittwoch, 1. Januar 2003
'// Hl. Drei Könige Montag, 6. Januar 2003
'// Rosenmontag Montag, 3. März 2003
'// Aschermittwoch Mittwoch, 5. März 2003
'// Karfreitag Freitag, 18. April 2003
'// Ostersonntag Sonntag, 20. April 2003
'// Ostermontag Montag, 21. April 2003
'// Maifeiertag Donnerstag, 1. Mai 2003
'// Christi Himmelfahrt Donnerstag, 29. Mai 2003
'// Pfingstsonntag Sonntag, 8. Juni 2003
'// Pfingstmontag Montag, 9. Juni 2003
'// Fronleichnam Donnerstag, 19. Juni 2003
'// Mariä Himmelfahrt Freitag, 15. August 2003
'// Tag der dt. Einheit Freitag, 3. Oktober 2003
'// Reformationstag Freitag, 31. Oktober 2003
'// Allerheiligen Samstag, 1. November 2003
'// Heiligabend Mittwoch, 24. Dezember 2003
'// Weihnachten1 Donnerstag, 25. Dezember 2003
'// Weihnachten2 Freitag, 26. Dezember 2003
'// Sylvester Mittwoch, 31. Dezember 2003
'// ----------------------------------------------------------------
End Sub

 

Sub BerechneFeiertage(Jahreszahl As Integer)

'// Als Refrenzdatum zunächst m_uDTF.Ostern berechnen
   If Not Ostern_berechnen(Jahreszahl) Then Exit Sub

'// Neujahr setzen (fester Feiertag am 1. Januar)
   m_uDTF.Neujahr = DateSerial(Jahreszahl, 1, 1)

'// Hl. Drei Könige setzen (fester Feiertag am 6. Januar)
   m_uDTF.DreiKoenige = DateSerial(Jahreszahl, 1, 6)

'// Rosenmontag berechnen 
'// (beweglicher Feiertag; 48 Tage vor Ostern)
   m_uDTF.Rosenmontag = m_uDTF.Ostern - 48

'// Aschemittwoch berechnen 
'// (beweglicher Feiertag; 46 Tage vor Ostern)
   m_uDTF.Aschermittwoch = m_uDTF.Ostern - 46

'// Karfreitag berechnen 
'// (beweglicher Feiertag; 2 Tage vor Ostern)
   m_uDTF.Karfreitag = m_uDTF.Ostern - 2

'// Ostersonntag = m_uDTF.Ostern!
   m_uDTF.Ostersonntag = m_uDTF.Ostern

'// Ostermontag berechnen 
'// (beweglicher Feiertag; 1 Tag nach Ostern)
   m_uDTF.Ostermontag = m_uDTF.Ostern + 1

'// Maifeiertag setzen (fester Feiertag am 1. Mai)
   m_uDTF.Maifeiertag = DateSerial(Jahreszahl, 5, 1)

'// Christi Himmelfahrt berechnen 
'// (beweglicher Feiertag; 39 Tage nach Ostern)
   m_uDTF.ChrHimmelfahrt = m_uDTF.Ostern + 39

'// Pfingstsonntag berechnen 
'// (beweglicher Feiertag; 49 Tage nach Ostern)
   m_uDTF.Pfingstsonntag = m_uDTF.Ostern + 49

'// Pfingstmontag berechnen 
'// (beweglicher Feiertag; 50 Tage nach Ostern)
   m_uDTF.Pfingstmontag = m_uDTF.Ostern + 50

'// Fronleichnam berechnen 
'// (beweglicher Feiertag; 60 Tage nach Ostern)
   m_uDTF.Fronleichnam = m_uDTF.Ostern + 60

'// Mariä Himmelfahrt setzen 
'// (fester Feiertag am 15. August)
   m_uDTF.MariaeHimmelfahrt = DateSerial(Jahreszahl, 8, 15)

'// Tag der deutschen Einheit setzen 
'// (fester Feiertag am 3. Oktober)
   m_uDTF.DtEinheit = DateSerial(Jahreszahl, 10, 3)

'// Reformationstag setzen 
'// (fester Feiertag am 31. Oktober)
   m_uDTF.Reformationstag = DateSerial(Jahreszahl, 10, 31)

'// Allerheiligen setzen (fester Feiertag am 1. November)
   m_uDTF.Allerheiligen = DateSerial(Jahreszahl, 11, 1)

'// Heiligabend setzen (fester 'Feiertag' am 24. Dezember)
   m_uDTF.Heiligabend = DateSerial(Jahreszahl, 12, 24)

'// Erster Weihnachtstag setzen 
'// (fester 'Feiertag' am 25. Dezember)
   m_uDTF.Weihnachten1 = DateSerial(Jahreszahl, 12, 25)

'// Zweiter Weihnachtstag setzen 
'// (fester 'Feiertag' am 26. Dezember)
   m_uDTF.Weihnachten2 = DateSerial(Jahreszahl, 12, 26)

'// Sylvester setzen (fester 'Feiertag' am 31. Dezember)
   m_uDTF.Sylvester = DateSerial(Jahreszahl, 12, 31)

End Sub

 

Function Ostern_berechnen(ByVal lYear As Long) As Boolean

'// Berechnung mit Hilfe des Algorithmus von Gauß
On Error GoTo Err_Ostern_berechnen

Dim i1 As Integer
Dim i2 As Integer
Dim i3 As Integer
Dim i4 As Integer
Dim i5 As Integer
Dim iTZ As Integer '// iTZ = Tageszahl

   i1 = lYear Mod 19 '// Formel nach Gauß
   i2 = lYear Mod 4 '// Werte für die Jahre
   i3 = lYear Mod 7 '// 1900 - 2099
   i4 = (19 * i1 + 24) Mod 30
   i5 = (2 * i2 + 4 * i3 + 6 * i4 + 5) Mod 7
   iTZ = 22 + i4 + i5 '// Ermittelt den Tag
   If iTZ > 31 Then '// März oder April
      iTZ = iTZ - 31 '// Wenn April, dann - 31 Tage
      If iTZ = 26 Then iTZ = 19 '// Wenn 26.4. dann 19.4.
      If (iTZ = 25 And i4 = 28 And i1 > 10) Then iTZ = 18
      m_uDTF.Ostern = DateSerial(lYear, 4, iTZ) '// Ostern im April
   Else
      m_uDTF.Ostern = DateSerial(lYear, 3, iTZ) '// Ostern im Maerz
   End If
   Ostern_berechnen = True

Exit_Ostern_berechnen:
   Exit Function

Err_Ostern_berechnen:
   Ostern_berechnen = False
   GoTo Exit_Ostern_berechnen

End Function

Zum Testen geben Sie in Direktbereich bzw. das Direktfenster innerhalb der Codeansicht den Text Beispiel ein und bestätigen mit der Enter-Taste. Die Funktion listet Ihnen alle Feiertage des Jahres auf. 

Zurück zu Tipps und Tricks

All Rights Reserved 2006. http://www.rolffs.de Design by Rolffs WebDesign
Datenschutzerklärung