code.fastix.org

Dateiansicht:

Datei:Projekte -> Excel:VBA:Feiertage -> Feiertage.vba
md5:20963b82cbb5a32d3ce164aab788a2cc
sha1:d3d42543b1687eebecea7b7947bb15d6f52f1a2e
  1. Option Explicit
  2.  
  3.  
  4. Public Function Eastersunday(Jahr As Date) As Date
  5.  
  6.     ' Osterfunktion nach Carl Friedrich Gauß (1800).
  7.     ' Rückgabewert ist der Datumswert des Ostersonntags im angegebenen Jahr.
  8.     ' Gültigkeitsbereich: 1900 - 8702. Im Fehlerfall wird FALSE zurückgegeben
  9.  
  10.     Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
  11.  
  12.     If (Jahr < 1583) Or (Jahr > 8702) Then
  13.         Eastersunday = False
  14.         Return
  15.     End If
  16.        
  17.     ' Die "magische" Gauss-Formel anwenden:
  18.     a = Jahr Mod 19
  19.     b = Jahr \ 100
  20.     c = (8 * b + 13) \ 25 - 2
  21.     d = b - (Jahr \ 400) - 2
  22.     e = (19 * (Jahr Mod 19) + ((15 - c + d) Mod 30)) Mod 30
  23.     If e = 28 Then
  24.         If a > 10 Then
  25.             e = 27
  26.         End If
  27.     ElseIf e = 29 Then
  28.         e = 28
  29.     End If
  30.     f = (d + 6 * e + 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6) Mod 7
  31.  
  32.     Eastersunday = DateSerial(Jahr, 3, e + f + 22)
  33.  
  34. End Function
  35.  
  36.  
  37. Public Function Advent4(Jahr As Long) As Date
  38.     Dim WT As Long
  39.     WT = Weekday(DateSerial(Jahr, 12, 25))
  40.     If (WT = 1) Then
  41.         WT = 8
  42.     End If
  43.     Advent4 = DateSerial(Jahr, 12, 25 - WT + 1)
  44. End Function
  45.  
  46. Public Function Ewigkeitssonntag(Jahr As Long) As Date
  47.     Dim WT As Long
  48.     WT = Weekday(DateSerial(Jahr, 12, 25))
  49.     If (WT = 1) Then
  50.         WT = 7
  51.     End If
  52.     Ewigkeitssonntag = DateSerial(Jahr, 12, 25 - 35 - WT + 1)
  53. End Function
  54.