VBA Tipp: Osterdatum ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte das Datum des Ostersonntags im jeweiligen Jahr ermitteln.

Lösung

Public Function Oster_Sonntag(Jahr)
Dim M As Integer, n As Integer, I As Integer, j As Integer, t As Integer
Dim A As Integer, B As Integer, C As Integer, D As Integer, e As Integer
 
  Select Case Jahr
    Case 1582 To 1699: M = 22: n = 2
    Case 1700 To 1799: M = 23: n = 3
    Case 1800 To 1899: M = 23: n = 4
    Case 1900 To 2099: M = 24: n = 5
    Case 2100 To 2199: M = 24: n = 6
    Case 2200 To 2299: M = 25: n = 7
    Case Else: MsgBox "ungültiges Datum": Exit Function
  End Select
 
  j = Jahr
  A = j Mod 19
  B = j Mod 4
  C = j Mod 7
  D = (19 * A + M) Mod 30
  e = (2 * B + 4 * C + 6 * D + n) Mod 7
 
  If (D + e) <= 9 Then
    Oster_Sonntag = DateSerial(Jahr, 3, 22 + D + e)
  Else
    Oster_Sonntag = DateSerial(Jahr, 4, D + e - 9)
  End If
  If A = 16 And D = 28 And e = 6 Then Oster_Sonntag = DateSerial(Jahr, 4, 18)
  If D = 29 And e = 6 Then Oster_Sonntag = DateSerial(Jahr, 4, 19)
End Function


Thomas Prötzsch hat einen anderen Algorithmus vorgestellt:

Public Function Ostersonntag(Jahr As Integer) As Date
  Dim Gz As Integer, Jh As Integer, Schalt As Integer, Meton As Integer, _
  Epact As Integer, Wotag As Integer, OsterTag As Integer, _
  OsterMon As Integer, Monat As Integer
 
' von Stefan Germer / Thomas Prötzsch
 
  ' Goldene Zahl
  Gz = Int(Jahr Mod 19 + 1)
  ' Zahl des Jahrhunderts
  Jh = Int(Jahr / 100 + 1)
  ' Anzahl ausgelassener Schaltjahre
  Schalt = Int(((3 * Jh) / 4) - 12)
  ' Korrektur des metonischen Zyklus
  Meton = Int(((8 * Jh) + 5) / 25 - 5)
  ' Sonntag
  Wotag = Int((Jahr * 5) / 4 - Schalt - 10)
  ' Epact
  Epact = ((Gz * 11) + 20 + Meton - Schalt) Mod 30
  If (Epact = 25 And Gz > 11) Or Epact = 24 Then
    Epact = Epact + 1
  End If
  OsterTag = 44 - Epact
  If OsterTag < 21 Then
    OsterTag = OsterTag + 30
  End If
  OsterTag = OsterTag + 7 - ((Wotag + OsterTag) Mod 7)
  If OsterTag > 31 Then
    Monat = 4
    OsterTag = OsterTag - 31
  Else
    Monat = 3
  End If
  Ostersonntag = DateSerial(Jahr, Monat, OsterTag)
End Function


Und noch ein Algorithmus:

Public Function Oster_Sonntag1(Jahr)
Dim K As Long, M As Long, S As Long, A As Long, D As Long, _
    R As Long, OG As Long, SZ As Long, OE As Long
'
' H. Lichtenberg,
' Zur Interpretation der Gaußschen Osterformel und ihrer Ausnahmeregeln,
' Historia Mathematica 24 (1997), S. 441 - 444).
' Algorithmus angepasst nach A. Bauch / PTB
'
  K = Jahr \ 100
  M = 15 + ((3 * K + 3) \ 4) - ((8 * K + 13) \ 25)
  S = 2 - ((3 * K + 3) \ 4)
  A = Jahr Mod 19
  D = (19 * A + M) Mod 30
  R = (D \ 29) + ((D \ 28) - (D \ 29)) * (A \ 11)
  OG = 21 + D - R ' Märzdatum des Ostervollmonds
  ' = 14. Tag des ersten Monats im Mondkalender, genannt Nisanu)
  SZ = 7 - (Jahr + (Jahr \ 4) + S) Mod 7  'Datum des 1. Sonntags im März
  OE = 7 - (OG - SZ) Mod 7
  Oster_Sonntag1 = DateSerial(Jahr, 3, OG + OE)
End Function


Und hier noch etwas für Freunde des Einzeilers:

Public Function OsterSonntagEinzeiler(ByVal Jahr As Long) As Date
  OsterSonntagEinzeiler = CDate(IIf(Jahr = 2079,7,0)+(Fix(Format(CDbl(DateSerial(Jahr, 4, _
    Day((CDbl(Minute(Jahr / 38)) / 2) + 1516)) / 7), "0")) * 7) - 6)
End Function
Wiki hinweis.png Anmerkung zum Einzeiler: Allerdings gilt dieser Algorithmus nur für Jahre zwischen 1900 und 2200.


Weblinks