Code:
Function Feiertag(Datum As Date) As String
Dim J%, D%
Dim O As Date
J = Year(Datum)
'Osterberechnung
D = (((255 - 11 * (J Mod 19)) - 21) Mod 30) + 21
O = DateSerial(J, 3, 1) + D + (D > 48) + 6 - _
((J + J \ 4 + D + (D > 48) + 1) Mod 7)
'Feiertage berechnen
Select Case Datum
Case DateSerial(J, 1, 1)
Feiertag = "Neujahr"
Case DateSerial(J, 1, 6)
Feiertag = "Dreikönig"
Case DateAdd("D", -2, O)
Feiertag = "Karfreitag"
Case O
'Feiertag = "Ostersonntag"
Case DateAdd("D", 1, O)
Feiertag = "Ostermontag"
Case DateSerial(J, 5, 1)
Feiertag = "Erster Mai"
Case DateAdd("D", 39, O)
Feiertag = "Christi Himmelfahrt"
Case DateAdd("D", 49, O)
'Feiertag = "Pfingstsonntag"
Case DateAdd("D", 50, O)
Feiertag = "Pfingstmontag"
Case DateAdd("D", 60, O)
Feiertag = "Fronleichnam"
Case DateSerial(J, 8, 15)
'Feiertag = "Maria Himmelfahrt*"
Case DateSerial(J, 10, 3)
Feiertag = "Deutsche Einheit"
Case DateSerial(J, 11, 22) - (DateSerial(J, 11, 18) Mod 7)
Feiertag = "Buß- und Bettag"
Case DateSerial(J, 10, 31)
Feiertag = "Reformationstag"
Case DateSerial(J, 11, 1)
Feiertag = "Allerheiligen"
Case DateSerial(J, 12, 24)
'Feiertag = "Heiligabend"
Case DateSerial(J, 12, 25)
Feiertag = "1. Weihnachtstag"
Case DateSerial(J, 12, 26)
Feiertag = "2. Weihnachtstag"
Case DateSerial(J, 12, 31)
'Feiertag = "Silvester*"
Case Else
Feiertag = ""
End Select
End Function
Sub Alle_Feiertage()
With Sheets("Feiertage")
Dim i As Date, r As Integer, ret As String
r = 22
For i = #1/1/2018# To #12/31/2029#
ret = Feiertag(i)
If ret <> "" Then
r = r + 1
Cells(r, 1) = ret
Cells(r, 2) = i
'Cells(r, 3).FormulaR1C1 = "=VLOOKUP(RC[-2],R3C1:R18C17,R20C2,0)"
End If
Next i
End With
End Sub
