Feiertage berechnen

1
Fragen und Antworten zur Computerbedienung Thema :
Titel
Thema
Feiertage
Stichwort
Berechnen mit
VBA
Programm
VBA
Letzte Anpassung
11.05.2015
Kurzbeschreibung:
Feiertage berechnen ist ja bekanntlich nicht ganz einfach.
Viele Feiertage sind von Jahr zu Jahr an unterschiedlichen Tagen (variable Feiertage). 9 Feiertage sind
von den Ostern abhängig und diverse andere Feiertage sind jeweils an einem Sonntag im Monat (z.B.
3 So im Sept).
Beschreibung:
Hier finden Sie 2 Funktionen die dieses Problem perfekt lösen.
a) Function OsterSonntag(Jahr As Integer) as Date
b) Function FeiertagText(DatumX As Date, OsternJh As Date) As String
Sie sehen unten eine Tabelle in der in der Spalte A ein austeigendes Datum (Kalender) eingetragen ist.
In der Spalte B kann nun durch die beiden hier präsentierten Funktionen die Feiertage oder der Name
des Tages eingetragen werden.
Hier das Resultat ( Ausschnitt der Tabelle)
Der folgende Beispielcode erledigt das ….
' Feiertage eintragen
Ostern = OsterSonntag(Jahr)
For i = lngR To lngR + 370
Öffentliches Dokument gratis zu beziehen bei www.tiggi.ch
Ersteller Martin Küttel
2
Fragen und Antworten zur Computerbedienung Thema :
With ActiveSheet
Datum = Format(.Cells(i, 1).Value, "dd.mm.yyyy")
' Datum aus Spalte A
strDatum = FeiertagText(Datum, Ostern)
.Cells(i, 2).Value = strDatum
End With
Next lngRa
Im Folgenden sind die beiden Funktionen zu sehen. Sie können diesen Code mit Copy Paste in Ihr
VBA Programm übernehmen.
Function OsterSonntag(Jahr As Integer) as date
Dim d As Integer
d = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21
OsterSonntag = DateSerial(Jahr, 3, 1) + d + (d > 48) + 6 - ((Jahr + Jahr \ 4 + d + (d > 48) + 1) Mod
7)
End Function
Function FeiertagText(DatumX As Date, OsternJh As Date) As String
' gibt entweder einen Feiertag zurück oder den Namen des Tages z.B. Montag
' Funktion DateSerial(Jahr,Monat,Tag)
' Ostern mit der Funktion Ostersonntag ermitteln
' Muttertage immer 2. Sonntag im Mai
' Vatertag immer 1. Sonntag im Juni landesweit
' BussBettag immer 3. Sonntag im September
' Reformtionstag immer am 1 Sonntag im November
Dim Muttertag As Date
Dim Vatertag As Date
Dim BussBettag As Date
Dim Reformtag As Date
Dim SoZä As Integer
Jahr = Year(DatumX)
Monat = Month(DatumX)
'Die Speziellen Feiertage
Muttertag = DateSerial(Jahr, 5, 1)
Öffentliches Dokument gratis zu beziehen bei www.tiggi.ch
Ersteller Martin Küttel
3
Fragen und Antworten zur Computerbedienung Thema :
SoZä = 0
For i = 1 To 20
If Weekday(Muttertag) = 1 Then SoZä = SoZä + 1
If SoZä = 2 Then Exit For
Muttertag = Muttertag + 1
Next i
SoZä = 0
Vatertag = DateSerial(Jahr, 6, 1)
For i = 1 To 13
If Weekday(Vatertag) = 1 Then SoZä = SoZä + 1
If SoZä = 1 Then Exit For
Vatertag = Vatertag + 1
Next i
SoZä = 0
BussBettag = DateSerial(Jahr, 9, 1)
SoZä = 0
For i = 1 To 27
If Weekday(BussBettag) = 1 Then SoZä = SoZä + 1
If SoZä = 3 Then Exit For
BussBettag = BussBettag + 1
Next i
SoZä = 0
Reformtag = DateSerial(Jahr, 11, 1)
For i = 1 To 13
If Weekday(Reformtag) = 1 Then SoZä = SoZä + 1
If SoZä = 1 Then Exit For
Reformtag = Reformtag + 1
Next i
' Feiertag als Text ermitteln
Select Case DatumX
Case Is = DateSerial(Jahr, 1, 1)
FeiertagText = "Neujahr"
Case Is = DateSerial(Jahr, 1, 2)
Öffentliches Dokument gratis zu beziehen bei www.tiggi.ch
Ersteller Martin Küttel
4
Fragen und Antworten zur Computerbedienung Thema :
FeiertagText = "Berchtoldstag"
Case Is = DateSerial(Jahr, 1, 6)
FeiertagText = "Hl.3 Koenige"
Case Is = DateSerial(Jahr, 2, 14)
FeiertagText = "Valentintag"
Case Is = OsternJh - 52
FeiertagText = "Altweiber"
Case Is = OsternJh - 48
FeiertagText = "Rosenmontag"
Case Is = OsternJh - 2
FeiertagText = "Karfreitag"
Case Is = OsternJh
FeiertagText = "Ostersonntag"
Case Is = OsternJh + 1
FeiertagText = "Ostermontag"
Case Is = DateSerial(Jahr, 5, 1)
FeiertagText = "Tag der Arbeit"
Case Is = Muttertag
FeiertagText = "Muttertag"
Case Is = Vatertag
FeiertagText = "Vatertag"
Case Is = OsternJh + 39
FeiertagText = "Auffahrt"
Case Is = OsternJh + 49
FeiertagText = "Pfingsten"
Case Is = OsternJh + 50
FeiertagText = "Pfingstmontag"
Case Is = OsternJh + 60
FeiertagText = "Fronleichnam"
Case Is = DateSerial(Jahr, 8, 1)
FeiertagText = "Nationalfeiertag"
Case Is = BussBettag
FeiertagText = "Buss & Bettag"
Öffentliches Dokument gratis zu beziehen bei www.tiggi.ch
Ersteller Martin Küttel
5
Fragen und Antworten zur Computerbedienung Thema :
Case Is = DateSerial(Jahr, 11, 1)
FeiertagText = "Allerheiligen"
Case Is = Reformtag
FeiertagText = "Reformationstag"
Case Is = DateSerial(Jahr, 12, 6)
FeiertagText = "St. Niklaus"
Case Is = DateSerial(Jahr, 12, 24)
FeiertagText = "heilig Abend"
Case Is = DateSerial(Jahr, 12, 25)
FeiertagText = "Weihnachten"
Case Is = DateSerial(Jahr, 12, 26)
FeiertagText = "Stephantag"
Case Is = DateSerial(Jahr, 12, 31)
FeiertagText = "Sylvester"
Case Else
FeiertagText = Format(DatumX, "dddd")
End Select
End Function
Öffentliches Dokument gratis zu beziehen bei www.tiggi.ch
Ersteller Martin Küttel

Download Report