Hallo
Vielleicht kannst du das ja noch gebrauchen!
Feiertage werden mit einem Kommentar versehen!
Gruß Nighty
Einmaliger lauf,danach kann die Function und das Modul wieder gelöscht werden
Selektiere einen beliebigen Bereich (in deinem Fall,die erste Zeile(Datumsreihe))
Makrostart
Alle Feiertage werden mit einen Kommentarfeld versehen und Namentlich in diesen angezeigt
Sub Feiertage_im_Kommentarfeld()
Dim Zelle As Object, Eintrag As Object
For Each Zelle In Selection
If IsDate(Zelle) And Feiertag2(Range(Zelle.Address)) <> "" Then
Set Eintrag = Range(Zelle.Address).Comment
If Eintrag Is Nothing Then
Range(Zelle.Address).AddComment
Range(Zelle.Address).Comment.Text Text:="Feiertag:" & Chr(10) & Feiertag2(Range(Zelle.Address))
Else
Range(Zelle.Address).ClearComments
Range(Zelle.Address).AddComment
Range(Zelle.Address).Comment.Text Text:="Feiertag:" & Chr(10) & Feiertag2(Range(Zelle.Address))
End If
End If
Next Zelle
End Sub
Function Feiertag2(Zelle As Date) As String
Dim DatumString As String
Dim IntYear As Integer, OsterDatum As Integer
IntYear = Year(Zelle)
OsterDatum = (((255 - 11 * (IntYear Mod 19)) - 21) Mod 30) + 21
DatumString = _
DateSerial(IntYear, 1, 1) & _
DateSerial(IntYear, 1, 6) & _
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) - 2 & _
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 1 & _
DateSerial(IntYear, 5, 1) & _
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 39 & _
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 50 & _
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 60 & _
DateSerial(IntYear, 10, 3) & _
DateSerial(IntYear, 11, 1) & _
DateSerial(IntYear, 12, 24) & _
DateSerial(IntYear, 12, 25) & _
DateSerial(IntYear, 12, 26) & _
DateSerial(IntYear, 12, 31) & _
"31.10.2017"
FName = Array("Neujahr", "Dreikönig", "Karfreitag", "Ostermontag", "Tag der Arbeit", "Christi Himmelfahrt", "Pfingstmontag", "Fronleichnam", "Tag der Einheit", "Allerheiligen", "Heiligabend", "1. Weihnachtstag", "2. Weihnachtstag", "Silvester", "Reform")
If InStr(DatumString, Zelle) > 0 Then Feiertag2 = FName(InStr(DatumString, Zelle) / 10)
End Function