'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'Ostersonntag nach gregorianischem Kalender ab dem Jahr 1583

'die Funktionen hatte ich ursprüglich in Visual Basic geschrieben und genutzt -
'für die Nutzung unter Excel hab ich nur die Ein- und Ausgabe an Excel angepaßt


Private Function oster_jt(Optional testjahr As Variant) As String
'mit =DatWert(oster_jt()) wird das Ostersonntagsdatum im aktuellen Jahr bestimmt
   oster_jt = "#WERT"
   On Error GoTo exit_oster_jt
   If IsMissing(testjahr) Then testjahr = Year(Now)
   testjahr = CInt(testjahr)
   If testjahr > 1582 And testjahr < 10000 Then
     A = testjahr Mod 19
     B = testjahr Mod 4
     C = testjahr Mod 7
     k = Int(testjahr / 100)
     q = Int(k / 4)
     p = Int((13 + (8 * k)) / 25)
     D = ((19 * A) + 15 + k - q - p) Mod 30
     E = ((2 * B) + (4 * C) + (6 * D) + 4 + k - q) Mod 7
     test = (D + E)
     If test <= 9 Then
        oster_jt = (22 + D + E) & ".03." & testjahr
     End If
     If test > 9 Then
        oster_jt = (D + E - 9) & ".04." & testjahr
        If (D + E - 9) = 26 Then oster_jt = (D + E - 9 - 7) & ".04." & testjahr
        If D = 28 And E = 6 And A > 10 Then oster_jt = (D + E - 9 - 7) & ".04." & testjahr
     End If
  Else
  oster_jt = "#WERT"
  End If
exit_oster_jt:
End Function

Private Function oster_dj(testdatum As String, Optional startjahr, Optional suche_in = 1) As String
'testdatum im Format "tt.m." im Bereich 22.3. bis 25.4.
'suche_in = 1 ist Zukunft
'suche_in = -1 ist Vergangenheit
'z.B. "15.4." in Zelle A1
'=oster_dj($a$1) in Zelle A2
'=oster_dj($a$1;A2+1) in Zelle A3 bzw. =oster_dj($a$1;A2-1;-1)
'und dann Zelle A3 "nach unten" kopiert
'erzeugt eine Liste aller Jahre, in welchen
'der 15.4. der Ostersonntag war oder sein wird
'die Suchrichtung wird durch suche_in bestimmt!

'init
   gefunden = False
   oster_dj = ""
   On Error GoTo oster_abbr
   
   If suche_in <> 1 Then
      suche_in = -1
   End If
   
   If IsNull(startjahr) Or IsMissing(startjahr) Then startjahr = Year(Now)
   
   testtag = CInt(Left$(testdatum, 2))
   testmonat = CInt(Mid$(testdatum, 4, 1))
   
   'If startjahr < 1583 Or startjahr > 5000 Or startjahr = Null Then
   'geht so nur in Visual Basic, hier muß isnull(startjahr) extra
   'geprüft werden, um keinen Fehlerabbruch zu erhalten
   If startjahr < 1583 Or startjahr > 9999 Then
      startjahr = Year(Now)
   End If
   On Error GoTo oster_abbr

   If testmonat < 3 Or testmonat > 4 Then GoTo oster_abbr
   If testmonat = 3 And testtag < 22 Then GoTo oster_abbr
   If testmonat = 4 And testtag > 25 Then GoTo oster_abbr

   Do
     If startjahr > 1582 And startjahr <= 9999 Then
       A = startjahr Mod 19
       B = startjahr Mod 4
       C = startjahr Mod 7
       k = Int(startjahr / 100)
       q = Int(k / 4)
       p = Int((13 + (8 * k)) / 25)
       D = ((19 * A) + 15 + k - q - p) Mod 30
       E = ((2 * B) + (4 * C) + (6 * D) + 4 + k - q) Mod 7
       test = (D + E)
       If ((test <= 9) And (testmonat = 3)) Then
         If testtag = (22 + D + E) Then
           oster_dj = startjahr
           gefunden = True
         End If
       End If
       If ((test > 9) And (testmonat = 4)) Then
         If (D + E - 9) = 26 Then
           If testtag = (D + E - 16) Then
             oster_dj = startjahr
             gefunden = True
           End If
         End If
         If (D + E - 9) = 25 Then
           If D = 28 And E = 6 And A > 10 Then
             If testtag = (D + E - 9) Then
               oster_dj = startjahr
               gefunden = True
             End If
           End If
           If testtag = (D + E - 16) Then
             oster_dj = startjahr
             gefunden = True
           End If
         End If
         If (D + E - 9) < 25 Then
           If testtag = (D + E - 9) Then
             oster_dj = startjahr
             gefunden = True
           End If
         End If
       End If
     Else
       gefunden = True
       oster_dj = "#WERT"
     End If
     startjahr = startjahr + suche_in
  Loop Until gefunden
  GoTo oster_ende
oster_abbr:
  oster_dj = "#WERT"
oster_ende:
End Function

'Tage seit Ostersonntag
Function s_ostern(Optional testdatum As Variant) As Integer
 If IsMissing(testdatum) Then testdatum = Now()
 testdatum = CDate(testdatum)
 Jahr = Year(testdatum)
 oster_test = DateValue(oster_jt(Jahr))
 If oster_test > testdatum Then oster_test = DateValue(oster_jt(Jahr - 1))
 s_ostern = CInt(Fix(testdatum) - CLng(oster_test))
End Function

'Tage bis Ostersonntag
Function b_ostern(Optional testdatum As Variant) As Integer
 If IsMissing(testdatum) Then testdatum = Now()
 testdatum = CDate(testdatum)
 Jahr = Year(testdatum)
 oster_test = DateValue(oster_jt(Jahr))
 If oster_test < testdatum Then oster_test = DateValue(oster_jt(Jahr + 1))
 b_ostern = CInt(CLng(oster_test) - Fix(testdatum))
End Function

Function Rosenmontag(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    Rosenmontag = Fix(DateValue(oster_jt(testjahr))) - 48
  Else
    Rosenmontag = "#Wert"
End If
End Function

Function Aschermittwoch(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    Aschermittwoch = Fix(DateValue(oster_jt(testjahr))) - 46
  Else
    Aschermittwoch = "#Wert"
End If
End Function

Function Karfreitag(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    Karfreitag = Fix(DateValue(oster_jt(testjahr))) - 2
  Else
    Karfreitag = "#Wert"
  End If
End Function

Function Ostermontag(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    Ostermontag = Fix(DateValue(oster_jt(testjahr))) + 1
  Else
    Ostermontag = "#Wert"
  End If
End Function

Function ChristiHimmelfahrt(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    ChristiHimmelfahrt = Fix(DateValue(oster_jt(testjahr))) + 39
  Else
    ChristiHimmelfahrt = "#Wert"
  End If
End Function

Function Pfingstsonntag(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  If testjahr >= 1900 Then
    Pfingstsonntag = Fix(DateValue(oster_jt(testjahr))) + 49
  Else
    Pfingstsonntag = "#Wert"
  End If
End Function

Function Pfingstmontag(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  Pfingstmontag = Empty
  If testjahr >= 1900 Then
    Pfingstmontag = Fix(DateValue(oster_jt(testjahr))) + 50
  Else
    Pfingstmontag = "#Wert"
  End If
End Function

Function Fronleichnam(Optional testjahr As Variant) As Date
  If IsMissing(testjahr) Then testjahr = Year(Now())
  testjahr = CInt(testjahr)
  Fronleichnam = Empty
  If testjahr >= 1900 Then
    Fronleichnam = Fix(DateValue(oster_jt(testjahr))) + 60
  Else
    Fronleichnam = "#Wert" 'irgendwas, um eine Fehlermeldung zu erzeugen
  End If
End Function