Feiertage erkennen, markieren

564 Aufrufe
Gefragt 3 Mai in Tabellenkalkulation von ahorn38 Experte (2,646 Punkte)
Hallo,

ich [xurl=http://jamaipa.de|Jamaipa - Suche ohne Spam und Shops]suche[/url] nach einem Code, der in einer Liste verschiedener Datums in Spalte "A"  die Feiertage erkennt und markiert.
Im web habe ich noch nichts passendes dazu gefunden außer Funktionen und Excel-Formeln, die aber mein Problem nicht vollständig lösen. Hat jemand einen Tipp?
Danke und Gruß A.

10 Antworten

0 Punkte
Beantwortet 3 Mai von m-o Profi (11,159 Punkte)
Hallo Andreas,

einen solchen Code wirst du wahrscheinlich nicht finden. Es gibt Codes, mit denen du die variablen Feiertage berechnen kannst. Andere Feiertage haben ein festes Datum und einige Feiertage gelten nur in bestimmten Bundesländern bzw. teilweise sogar nur in einzelnen Regionen.

Ich habe für eines meiner Projekte eine Liste mit den für mich gültigen Feiertagen für das betreffende Jahr erstellt. Damit habe ich dann die Feiertage in einem Kalender markiert.

Falls es sich immer nur um Daten aus einem Jahr handelt kannst du entsprechend vorgehen. Falls es Daten aus verschiedenen Jahren sind, müsstest du eben für jedes Datum einzeln prüfen, ob ein Feiertag auf dieses Datum fällt.

Gruß
M.O.
0 Punkte
Beantwortet 3 Mai von steffen2 Experte (3,656 Punkte)
und wenn du das jedes Jahr benötigst, kannst du die jeweiligen Feiertage auch teilweise berechnen. Der Abstand von Ostern, Himmelfahrt und Pfingsten z.B. ist immer gleich.

Gruß Steffen2
0 Punkte
Beantwortet 3 Mai von ahorn38 Experte (2,646 Punkte)
Danke für die Tipps.
Ich habe einmal eine variable Liste der Feiertage für ein beliebiges Jahr erstellt. Diese würde ich jetzt in einem Array ablegen und dann in einer Schleife abfragen und markieren:

[code]Sub feiertage()
Dim a As Long, b As Long, c As Long, d As Long, e As Long, f As Long
Dim OsterSo As Date
'
' Wurde kein Jahr angegeben, wird das aktuelle Jahr verwendet:
If Jahr = 0 Then
  Jahr = Year(Now)
End If

' Die "magische" Gauss-Formel anwenden:
a = Jahr Mod 19
b = Jahr \ 100
c = (8 * b + 13) \ 25 - 2
d = b - (Jahr \ 400) - 2
e = (19 * (Jahr Mod 19) + ((15 - c + d) Mod 30)) Mod 30
If e = 28 Then
  If a > 10 Then
    e = 27
  End If
ElseIf e = 29 Then
  e = 28
End If
f = (d + 6 * e + 2 * (Jahr Mod 4) + 4 * (Jahr Mod 7) + 6) Mod 7
OsterSo = DateSerial(Jahr, 3, e + f + 22)

i = 1
Cells(i, 2) = DateSerial(Jahr, 1, 1)
Cells(i, 3) = "Neujahr"
i = i + 1
Cells(i, 2) = DateAdd("d", -2, OsterSo)
Cells(i, 3) = "Karfreitag"
i = i + 1
Cells(i, 2) = DateSerial(Jahr, 3, e + f + 22)
Cells(i, 3) = "Ostersonntag"
i = i + 1
Cells(i, 2) = DateAdd("d", 1, OsterSo)
Cells(i, 3) = "Ostermontag"
i = i + 1
Cells(i, 2) = DateSerial(Jahr, 5, 1)
Cells(i, 3) = "1.Mai"
i = i + 1
Cells(i, 2) = DateAdd("d", 39, OsterSo)
Cells(i, 3) = "ChristiHimmelfahrt"
i = i + 1
Cells(i, 2) = DateAdd("d", 49, OsterSo)
Cells(i, 3) = "Pfingstsonntag"
i = i + 1
Cells(i, 2) = DateAdd("d", 50, OsterSo)
Cells(i, 3) = "Pfingstmontag"
i = i + 1
'Cells(i, 2) = DateAdd("d", 60, OsterSo)
'Cells(i, 3) = "Fronleichnam"
'i = i + 1
'Cells(i, 2) = DateSerial(Jahr, 12, 25) - Weekday(DateSerial(Jahr, 12, 25), vbMonday) - 4 * 7 - vbWednesday
'Cells(i, 3) = "BußundBetTag"
'i = i + 1
Cells(i, 2) = DateSerial(Jahr, 10, 3)
Cells(i, 3) = "TagDerEinheit"
i = i + 1
Cells(i, 2) = DateSerial(Jahr, 10, 31)
Cells(i, 3) = "Reformationstag"
i = i + 1
Cells(i, 2) = DateSerial(Jahr, 12, 25)
Cells(i, 3) = "1.Weihnachsfeiertag"
i = i + 1
Cells(i, 2) = DateSerial(Jahr, 12, 26)
Cells(i, 3) = "2.Weihnachsfeiertag"
i = i + 1

End Sub[/code]
Gruß A.
0 Punkte
Beantwortet 4 Mai von Nighty___
Hallo Andreas .-)

Ein Beispiel!

Gruß Nighty

Bei Fund = True

Feld 14,0 wäre dann ein weiterer Feiertag
Feld 14,1 dessen Namensgebung

Namensgebung dient zur Zeit nur der Orientierung bzw Umgestaltung der Function

[code]Function Feiertag(Zelle As Date) As Boolean
    Dim varDates(13, 1) As Variant
    Dim IntYear As Integer, Index As Integer
    IntYear = Year(Zelle)
    varDates(0, 0) = DateSerial(IntYear, 1, 1)
    varDates(0, 1) = "Neujahr"
    varDates(1, 0) = DateSerial(IntYear, 1, 6)
    varDates(1, 1) = "Dreikönig"
    varDates(2, 0) = dEaster - 3
    varDates(2, 1) = "Karfreitag"
    varDates(3, 0) = dEaster + 1
    varDates(3, 1) = "Ostermontag"
    varDates(4, 0) = DateSerial(IntYear, 5, 1)
    varDates(4, 1) = "Tag der Arbeit"
    varDates(5, 0) = dEaster + 39
    varDates(5, 1) = "Christi Himmelfahrt"
    varDates(6, 0) = dEaster + 50
    varDates(6, 1) = "Pfingstmontag"
    varDates(7, 0) = dEaster + 60
    varDates(7, 1) = "Fronleichnam"
    varDates(8, 0) = DateSerial(IntYear, 10, 3)
    varDates(8, 1) = "Tag der Einheit"
    varDates(9, 0) = DateSerial(IntYear, 11, 1)
    varDates(9, 1) = "Allerheiligen"
    varDates(10, 0) = DateSerial(IntYear, 12, 24)
    varDates(10, 1) = "Heiligabend"
    varDates(11, 0) = DateSerial(IntYear, 12, 25)
    varDates(11, 1) = "1. Weihnachtstag"
    varDates(12, 0) = DateSerial(IntYear, 12, 26)
    varDates(12, 1) = "2. Weihnachtstag"
    varDates(13, 0) = DateSerial(IntYear, 12, 31)
    varDates(13, 1) = "Silvester"
    For Index = 0 To UBound(varDates)
        If Zelle = varDates(Index, 0) Then
            Feiertag = True
            Exit For
        End If
    Next Index
End Function[/code]
0 Punkte
Beantwortet 4 Mai von ahorn38 Experte (2,646 Punkte)
Danke nighty und den andern für die Hilfe. Problem gelöst!
Gruß A.
0 Punkte
Beantwortet 6 Mai von Nighty___
Hallo Andreas

Habe noch die Berechnungsdaten eingesetzt

Gruß Nighty

Rückgabewert True könnte durch varDates(x,0) oder varDates(x,1) ersetzte werden
 varDates(x,0)=Datum
 varDates(x,1) =Bezeichner

[code]Function Feiertag(Zelle As Date) As Boolean
    Dim varDates(13, 1) As Variant
    Dim IntYear As Integer, Index As Integer
    IntYear = Year(Zelle)
    OsterDatum = (((255 - 11 * (IntYear Mod 19)) - 21) Mod 30) + 21
    varDates(0, 0) = DateSerial(IntYear, 1, 1)
    varDates(0, 1) = "Neujahr"
    varDates(1, 0) = DateSerial(IntYear, 1, 6)
    varDates(1, 1) = "Dreikönig"
    varDates(2, 0) = DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) - 2
    varDates(2, 1) = "Karfreitag"
    varDates(3, 0) = DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 1
    varDates(3, 1) = "Ostermontag"
    varDates(4, 0) = DateSerial(IntYear, 5, 1)
    varDates(4, 1) = "Tag der Arbeit"
    varDates(5, 0) = DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 39
    varDates(5, 1) = "Christi Himmelfahrt"
    varDates(6, 0) = DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 50
    varDates(6, 1) = "Pfingstmontag"
    varDates(7, 0) = DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) + 60
    varDates(7, 1) = "Fronleichnam"
    varDates(8, 0) = DateSerial(IntYear, 10, 3)
    varDates(8, 1) = "Tag der Einheit"
    varDates(9, 0) = DateSerial(IntYear, 11, 1)
    varDates(9, 1) = "Allerheiligen"
    varDates(10, 0) = DateSerial(IntYear, 12, 24)
    varDates(10, 1) = "Heiligabend"
    varDates(11, 0) = DateSerial(IntYear, 12, 25)
    varDates(11, 1) = "1. Weihnachtstag"
    varDates(12, 0) = DateSerial(IntYear, 12, 26)
    varDates(12, 1) = "2. Weihnachtstag"
    varDates(13, 0) = DateSerial(IntYear, 12, 31)
    varDates(13, 1) = "Silvester"
    For Index = 0 To UBound(varDates)
        If Zelle = varDates(Index, 0) Then
            Feiertag = True
            Exit For
        End If
    Next Index
End Function [/code]
0 Punkte
Beantwortet 8 Mai von Nighty___
Hallo Andreas :-)

Ohne Schleife!

Gruß Nighty

Rückgabewert ist diesmal der Feiertagsname!

[code]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)
    FName = Array("Neujahr", "Dreikönig", "Karfreitag", "Ostermontag", "Tag der Arbeit", "Christi Himmelfahrt", "Pfingstmontag", "Fronleichnam", "Tag der Einheit", "Allerheiligen", "Heiligabend", "1. Weihnachtstag", "2. Weihnachtstag", "Silvester")
    If InStr(DatumString, Zelle) > 0 Then Feiertag2 = FName(InStr(DatumString, Zelle) / 10)
End Function[/code]
0 Punkte
Beantwortet 16 Mai von Nighty___
Hallo Community

Nicht wiederkehrende Feierteage werden so ergänzt!

Gruß Nighty

Der letzte Eintrag waere einer! > "31.10.2017"
Der Bezeichner läuft Parallel zum Datumstring,ist also im Array der letzte Eintrag

[code]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[/code]
0 Punkte
Beantwortet 19 Mai von Nighty___
Hallo Community

Da das Interesse größer ist als ich vermutete,hier ein Code der einen Selectierten Bereich auf Datum Abtastet und den jeweiligen Feiertag in das Kommentarfeld einträgt
Der Selectierte Bereich kann ein oder mehrere Monate oder Jahre beinhalten!

Feiertage
Feste,bewegliche oder einmalige Feiertage ,sollten den Bundesländern angepasst werden!


Syntax z.b.

Einmalige
"31.10.2017"

Feste
DateSerial(IntYear, 1, 6)

Bewegliche
DateSerial(IntYear, 3, 1) + OsterDatum + (OsterDatum > 48) + 6 - ((IntYear + IntYear \ 4 + OsterDatum + (OsterDatum > 48) + 1) Mod 7) - 2 &

Zum hinzufüfen
& _
bei dem letzten Eintrag

Gruß Nighty

[code]Sub Feiertage_im_Kommentarfeld()
    Dim Zelle As Object, Eintrag As Object
    For Each Zelle In Selection
        If IsDate(Zelle) 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
[/code]


Gruß Nighty
0 Punkte
Beantwortet 19 Mai von Nighty___
Hallo Community

ops ... korrigiert

Gruß Nighty

[code]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[/code]
...