|
Wie ermittelt man das Datum des
Ostersonntags?
Die folgende Funktion errechnet den korrekten Ostersonntag eines Jahres ohne Fallunterscheidungen anwenden zu müssen. Sie gilt für Jahre ab 1583 für alle Jahre des Gregorianischen Kalenders und für die Jahre 100 bis 1582 sowie für den Julianischen Kalender.
Die Funktion erwartet eine zumindest dreistellige Jahreszahl als Parameter und liefert das Datum des Ostersonntags des angegebenen Jahres zurück. Für Jahresangaben kleiner als 100 wird der 31.12.1899 (Datumswert 0) zurückgegeben.
Erstellen Sie in einem Modul (neu oder vorhanden) folgende Funktion:
Public Function CalcEasterDate(iYear As Integer) As Date
'*******************************************************
'Description: Berechnet den Ostersonntag eines Jahres
' nach Jean Meeus aus dem Buch Astronomical
' Formulae for Calculators
'Parameters: iYear
'Return: Date
'-------------------------------------------------------
'Beispiel: MsgBox CalcEasterDate(2002)
'*******************************************************
Dim i_A As Integer
Dim i_B As Integer
Dim i_C As Integer
Dim i_D As Integer
Dim i_E As Integer
Dim i_F As Integer
Dim i_G As Integer
Dim i_H As Integer
Dim i_I As Integer
Dim i_K As Integer
Dim i_L As Integer
Dim i_M As Integer
Dim i_N As Integer
Dim i_P As Integer
On Error GoTo HandleErr
Select Case iYear
Case Is > 1582
'Gregorianisch
i_A = iYear Mod 19
i_B = Int(iYear / 100)
i_C = iYear Mod 100
i_D = Int(i_B / 4)
i_E = i_B Mod 4
i_F = Int((i_B + 8) / 25)
i_G = Int((i_B - i_F + 1) / 3)
i_H = (19 * i_A + i_B - i_D - i_G + 15) Mod 30
i_I = Int(i_C / 4)
i_K = i_C Mod 4
i_L = (32 + 2 * i_E + 2 * i_I - i_H -
i_K) Mod 7
i_M = Int((i_A + 11 * i_H + 22 *
i_L) / 451)
i_N = Int((i_H + i_L - 7 * i_M + 114) / 31)
i_P = (i_H + i_L - 7 * i_M + 114) Mod 31
CalcEasterDate =
DateSerial(iYear, i_N, i_P + 1)
Case Else
' Julianisch
i_A = (19 * (iYear Mod 19) + 15) Mod 30
i_B = (2 * (iYear Mod 4) + 4 *
(iYear Mod 7) - i_A + 34) Mod 7
CalcEasterDate =
DateSerial(iYear,
Int((i_A + i_B + 114) / 31), _
(i_A + i_B + 114) Mod 31 + 1)
End Select
ExitHere:
Exit Function
HandleErr:
Select Case Err.Number
Case Else
MsgBox "Fehler " & Err.Number & ": " & _
Err.Description, vbCritical, "CalcEasterDate"
End Select
End Function |
Zurück zu Tipps und Tricks
|
