VBA Tipp: Osterdatum ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

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

Lösung

Algorithmus 1

Public Function OsterSonntag(ByVal Jahr As Integer) As Date
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim M As Integer, N As Integer, I As Integer, T As Integer, A As Integer
   Dim B As Integer, C As Integer, D As Integer, E As Integer
 
   Select Case Jahr
      Case 1583 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:         Err.Raise 5, , "ungültiges Jahr"
   End Select
 
   A = Jahr Mod 19
   B = Jahr Mod 4
   C = Jahr Mod 7
   D = (19 * A + M) Mod 30
   E = (2 * B + 4 * C + 6 * D + N) Mod 7
 
   If (D + E) <= 9 Then
      OsterSonntag = DateSerial(Jahr, 3, 22 + D + E)
   Else
      OsterSonntag = DateSerial(Jahr, 4, D + E - 9)
   End If
   If A = 16 And D = 28 And E = 6 Then OsterSonntag = DateSerial(Jahr, 4, 18)
   If D = 29 And E = 6 Then OsterSonntag = DateSerial(Jahr, 4, 19)
End Function

Algorithmus 2

Public Function OsterSonntag(ByVal Jahr As Long) As Long
   Dim Gz As Integer:       Dim Jh As Integer:       Dim Schalt As Integer
   Dim Meton As Integer:    Dim Epact As Integer:    Dim Wotag As Integer
   Dim OsterTag As Integer: Dim OsterMon As Integer: Dim Monat As Integer
 
   ' von Stefan Germer / Thomas Prötzsch
   ' Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If Jahr < 1583 Or Jahr > 9999 Then Err.Raise 5, , "ungültiges Jahr"
 
   ' 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

Algorithmus 3

Public Function OsterSonntag(ByVal Jahr As Long) As Long
   Dim K As Long: Dim M  As Long: Dim S  As Long: Dim A  As Long: Dim D As Long
   Dim R As Long: Dim OG As Long: Dim SZ As Long: Dim 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
   ' Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If Jahr < 1583 Or Jahr > 9999 Then Err.Raise 5, , "ungültiges Jahr"
 
   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
   OsterSonntag = DateSerial(Jahr, 3, OG + OE)
End Function
Wiki hinweis.png

Anmerkung: Scheint der schnellste Algorithmus zu sein.


Algorithmus 4

Public Function EasterUSNO(ByVal Year As Long) As Long
   Dim c As Long, n As Long, k As Long, i As Long
   Dim j As Long, l As Long, m As Long, d As Long
 
   ' Formula from the United States Naval Observatory
   ' The algorithm is due to J.-M. Oudin (1940) and is reprinted in Richards, E.G. 2012,
   ' "Calendars," Explanatory Supplement to the Astronomical Almanac, 3rd ed., S.E. Urban
   ' and P.K. Seidelmann eds., 600-601
   '
   ' Quelle: www.dbwiki.net oder www.dbwiki.de
 
   If Year < 1583 Or Year > 9999 Then Err.Raise 5, , "ungültiges Jahr"
 
   c = Year \ 100
   n = Year - 19 * (Year \ 19)
   k = (c - 17) \ 25
   i = c - c \ 4 - (c - k) \ 3 + 19 * n + 15
   i = i - 30 * (i \ 30)
   i = i - (i \ 28) * (1 - (i \ 28) * (29 \ (i + 1)) * ((21 - n) \ 11))
   j = Year + Year \ 4 + i + 2 - c + c \ 4
   j = j - 7 * (j \ 7)
   l = i - j
   m = 3 + (l + 40) \ 44
   d = l + 28 - 31 * (m \ 4)
   EasterUSNO = DateSerial(Year, m, d)
End Function

Algorithmus 5

Und hier noch etwas für Freunde des Einzeilers:

Public Function OsterSonntagEinzeiler(ByVal Jahr As Long) As Date
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   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