Feiertage in Kalender
26.11.2021 13:32:52
Marco
Ich weiß, dass das Thema mittlerweile schon einige mal kam, aber ich hab genau zu meinem Problem noch keine Antwort gefunden.
Zu meinem Aufbau der Datei. Ich habe einen Jahres-Arbeitsplan erstellt. Die Tabellenblätter wurden als Kalenderwochen mit der Bezeichnung 1 bis 52 angelegt. Dazu gibt es noch 3 weitere Arbeitsblätter mit individuellen Bezeichnungen. Das Datum pro KW befindet sich in Spalten nebeneinander, wobei jeder Tag zwei Spalten hat. Ging leider nicht anders. Das heißt dass das Datum in je zwei verbundene Zellen steht. Dh. Als Beispiel steht der 01.01.2021 in E5 und F5, der 02.01.2021 in G5 und H5 usw bis Sonntag. Alle Kalenderblätter sind absolut identisch aufgebaut. Das Datum wird dynamisch nach der Jahreszahl auf Blatt 1 berechnet und passt sich so an KW 1 an. Alle anderen Blätter richten sich danach aus.
Ich habe mit unten stehendem Code eine Berechnung der Feiertage gefunden. Nur wie bekomme ich es jetzt hin, dass Excel die einzelnen Kalenderblätter überprüft und mit den Feiertagen abgleicht?
Jeder Feiertag soll dabei als Kommentar in das entsprechende Datumsfeld geschrieben werden. Zudem soll das Datum in roter Schrift gekennzeichnet werden.
Hier der Code und wo müsste dieser hin, dass sich die Feiertage nach jeder Änderung der Jahreszahl in KW 1 (ist Zelle A1) neu abgleicht und anpasst?
Das gleiche bräuchte ich natürlich auch mit Geburtstagen der Mitarbeiter. Diese sind im Tabellenblatt "Mitarbeiter" in Spalte C untereinander ab C2 niedergeschrieben. Kann man hier dann auch im Kommentarfeld den Namen plus in Klammer das Alter anzeigen lassen?
Ich bin absolut plan- uns ratlos wie ich das umsetzen kann.
Vielen herzlichen Dank im Voraus!!
Hier der Code:
Function FeiertagDE(Datum As Date, Optional Bundesland As String, _
Optional bolKath As Boolean, Optional bolRosenmontag As Boolean, _
Optional bolDez24 As Boolean, Optional bolDez31 As Boolean, _
Optional bolAug08 As Boolean, Optional bolFronleichnam As Boolean) As String
'##Ersteller fcs, Datum: 2009-09-15
'Funktion ermittelt für das Datum, ob es auf einem Feiertag liegt und gibt den _
Feiertag zurück
'Option bolKatk - Marie Himmelfahrt für Bayern in überwiegend katholischen Gemeinden
'Option bolFronleichnam - für Sachsen und Thüringen gem spezieller Regelung
'Beispiel für Funktionsaufruf:
' strFeiertag = FeiertagDE(Datum:=.Cells(Zeile, 1).Value, Bundesland:="BY", bolKath:=True)
'Abkürzungen für Bundesland
'BW=Baden-Württemberg NI=Niedersachsen
'BY=Bayern NW=Nordrhein -Westfalen
'BE=Berlin RP=Rheinland -Pfalz
'BB=Brandenburg SL=Saarland
'HB=Bremen SN=Sachsen
'HH=Hamburg ST=Sachsen -Anhalt
'HE=Hessen SH=Schleswig -Holstein
'MV=Mecklenburg -Vorpommern TH=Thüringen
'Feiertage BW BY BE BB HB HH HE MV NI NW RP SL SN ST SH TH
'Neujahrstag (01.01.) x x x x x x x x x x x x x x x x
'Hl. Drei Könige (06.01.) x x x
'Karfreitag x x x x x x x x x x x x x x x x
'Ostermontag x x x x x x x x x x x x x x x x
'Tag der Arbeit (01.05.) x x x x x x x x x x x x x x x x
'Christi Himmelfahrt x x x x x x x x x x x x x x x x
'Pfingstmontag x x x x x x x x x x x x x x x x
'Fronleichnam x x x x x x 1 1
'Mariä Himmelfahrt (15.08.) k x
'Tag der dt. Einheit (03.10.) x x x x x x x x x x x x x x x x
'Reformationstag (31.10.) x x x x x
'Allerheiligen (01.11.) x x x x x
'Buß- u. Bettag x
'1.Weihnachtstag (25.12.) x x x x x x x x x x x x x x x x
'2. Weihnachtstag (26.12) x x x x x x x x x x x x x x x x
'x bedeutet gesetzlicher Feiertag
'k bedeutet gesetzlicher Feiertag in Gemeinden mit überwiegend katholischer _
Bevölkerung
'1 Sonderregelungen in SN und TH
On Error GoTo Fehler
Dim intJahr As Integer, Tag As Long
Dim x As Integer, Ostern As Date
Dim intI As Integer, arrDatum(1 To 20) As Date, arrText(1 To 20) As String
intJahr = VBA.Year(Datum)
'Ostertag ermitteln
x = (((255 - 11 * (intJahr Mod 19)) - 21) Mod 30) + 21
Ostern = DateSerial(intJahr, 3, 1) + x + (x > 48) + 6 - _
((intJahr + intJahr \ 4 + x + (x > 48) + 1) Mod 7)
'Feiertage Bundesweit
intI = 0
intI = intI + 1: arrDatum(intI) = DateSerial(intJahr, 1, 1): arrText(intI) = "Neujahr"
intI = intI + 1: arrDatum(intI) = Ostern - 2: arrText(intI) = "Karfreitag"
intI = intI + 1: arrDatum(intI) = Ostern: arrText(intI) = "Ostersonntag"
intI = intI + 1: arrDatum(intI) = Ostern + 1: arrText(intI) = "Ostermontag"
intI = intI + 1: arrDatum(intI) = DateSerial(intJahr, 5, 1): arrText(intI) = "Maifeiertag"
intI = intI + 1: arrDatum(intI) = Ostern + 39: arrText(intI) = "Christi Himmelfahrt"
intI = intI + 1: arrDatum(intI) = Ostern + 49: arrText(intI) = "Pfingstsonntag"
intI = intI + 1: arrDatum(intI) = Ostern + 50: arrText(intI) = "Pfingstmontag"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 10, 3): arrText(intI) = "Tag der deutschen Einheit"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 25): arrText(intI) = "1. Weihnachtstag"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 26): arrText(intI) = "2. Weihnachtstag"
'Feiertage in einzelnen Bundesländern
'Heilige 3 Könige (1.11.)
Select Case Bundesland
Case "BW", "BY", "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1): arrText(intI) = "Hl. 3 Könige"
End Select
'Fronleichnam
Select Case Bundesland
Case "BW", "BY", "HE", "NW", "RP", "SL"
intI = intI + 1
intI = intI + 1: arrDatum(intI) = Ostern + 60: arrText(intI) = "Fronleichnam"
Case "ST", "TH"
If bolFronleichnam = True Then
intI = intI + 1
intI = intI + 1: arrDatum(intI) = Ostern + 60: arrText(intI) = "Fronleichnam"
End If
End Select
'Marie Himmelfahrt (15.08.)
Select Case Bundesland
Case "SL"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1): arrText(intI) = "Marie Himmelfahrt"
Case "BY"
If bolKath = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1): arrText(intI) = "Marie Himmelfahrt"
End If
End Select
'Allerheiligen (01.11.)
Select Case Bundesland
Case "BW", "BY", "NW", "RP", "SL", "SN"
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 11, 1): arrText(intI) = "Allerheiligen"
End Select
'Buß- und Bettag (Mittwoch vor dem 23. November)
Select Case Bundesland
Case "SN"
intI = intI + 1
Tag = 22
Do Until VBA.Weekday(DateSerial(intJahr, 11, Tag)) = vbWednesday
Tag = Tag - 1
Loop
arrDatum(intI) = DateSerial(intJahr, 11, Tag): arrText(intI) = "Buß und Bettag"
End Select
'Sonstige arbeitsfreie Tage /Feiertage
'Rosenmontag
If bolRosenmontag = True Then
intI = intI + 1
arrDatum(intI) = Ostern - 48: arrText(intI) = "Rosenmontag"
End If
'8. August - Friedenstag Augsburg
If bolAug08 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 8, 8): arrText(intI) = "Friedenstag"
End If
'24. Dezember (Heiligen Abend)
If bolDez24 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 24): arrText(intI) = "Heiligabend"
End If
'31. dezember (Sylvester)
If bolDez31 = True Then
intI = intI + 1
arrDatum(intI) = DateSerial(intJahr, 12, 31): arrText(intI) = "Sylvester"
End If
'Eingabe-Datum prüfen
For intI = LBound(arrDatum) To intI
If Datum = arrDatum(intI) Then
FeiertagDE = arrText(intI)
Exit For
End If
Next
Err.Clear
Fehler:
With Err
If .Number 0 Then
FeiertagDE = "#Fehler!"
End If
End With
End Function
Anzeige
