... ich möchte was beisteuern, zwei Funktionen zur Ermittlung von Feiertagen in Deutschland. Die zweite Funktion benötigt die erste zur Ermittlung von Ostersonntag...
Function Ostersonntag(Jahr As Long)As String
%REM
Ostersonntag ist am ersten Sonntag nach dem ersten Vollmond im Frühling.
Die Gauss'sche Berechnung ist gültig für die Jahre 1583 - 2299
... Die Funktion benötigt das Jahr (vierstellig) als Übergabewert.
... Die Funktion gibt als Rückgabewert Ostersonntag als Datum zurück.
... Für den Fall eines nicht berechenbaren Jahres ist der Rückgabestring leer
nach dem Aufruf der Funktion muß dieser Fall extra abgefangen werden...
... If Ostersonntag(Jahr) = "" Then Exit Sub ... ansonsten Type mismatch
ata - Ohne Declarations - implizite Declaration
%END REM
Dim J As Integer
Dim m As Integer
Dim n As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Dim z As Integer
Dim Mnt As String
Dim Tg As String
Dim GO As String
J = Jahr
If J < 100 Then J = 1900 + J
Select Case J
Case Is < 1583
Msgbox Cstr(J) + " kann nicht berechnet werden", 0 , "Berechnung Ostersonntag"
Exit Function
Case Is < 1700
m = 22
n = 2
Case Is < 1800
m = 23
n = 3
Case Is < 1900
m = 23
n = 4
Case Is < 2100
m = 24
n = 5
Case Is < 2200
m = 24
n = 6
Case Is < 2300
m = 25
n = 0
Case Else
Msgbox Cstr(J) + " kann nicht berechnet werden", 0 , "Berechnung Ostersonntag"
Exit Function
End Select
a = J Mod 19
b = J Mod 4
c = J Mod 7
d = (19 * a + m) Mod 30
e = (2 * b + 4 * c + 6 * d + n) Mod 7
z = 22 + d + e
Mnt = "03"
If z > 31 Then z = d + e - 9: Mnt = "04"
Select Case Mnt
Case "04"
If z = 26 Then z = 19
If z = 25 Then
If D = 28 Then
If e = 6 Then
If a > 10 Then z = 18
End If
End If
End If
End Select
Tg = Ltrim$(Cstr(z))
If Len(Tg) = 1 Then Tg = "0" + Tg
GO = Tg + "." + Mnt + "." + Ltrim$(Cstr(J))
Ostersonntag=GO
End Function
Function Feiertag(CheckDate As String) As String
' # Ermittelt, ob das Datum CheckDate ein Feiertag ist...
' # Die Nicht-Feiertage können auskommentiert werden
' # => Rückgabe = "Feiertagsname" für Feiertag, Leerstring für Nicht-Feiertag
Dim FTag(21) As String
Dim FName(21) As String
Dim Jahr As String
Dim f As Integer
Dim cd As Integer
Dim OsterDatum As String
f=0
Jahr = Cstr(Year(CheckDate))
Feiertag = ""
' Die festen Feiertage
FTag(1)= "01.01." + Jahr ' Neujahr
FName(1) = "Neujahr"
FTag(2)= "06.01." + Jahr ' Heilige Drei Könige - BaWü, Bay
FName(2) = "Heilige Drei Könige"
FTag(3)= "01.01." + Cstr(Year(CheckDate) ) ' Neujahr
FName(3) = "Neujahr"
FTag(4)= "01.05." + Cstr(Year(CheckDate) ) ' Tag der Arbeit
FName(4) = "Tag der Arbeit"
FTag(5)= "15.08." + Cstr(Year(CheckDate) ) ' Mariä Himmelfahrt - Saar, teilweise in Bay und Thür.
FName(5) = "Mariä Himmelfahrt"
FTag(6)= "03.10." + Cstr(Year(CheckDate) ) ' Tag der deutschen Einheit
FName(6) = "Tag der deutschen Einheit"
FTag(7)= "31.10." + Cstr(Year(CheckDate) ) ' Reformationstag - Brand., MeVo. , Sa, SaAn. , teilweise in Thür.
FName(7) = "Reformationstag"
FTag(8)= "01.11." + Cstr(Year(CheckDate) ) ' Allerheiligen - BAWü. , Bay, NRW , RhPf. , Saar. und teilweise in Thür.
FName(8) = "Allerheiligen"
FTag(9)= "24.12." + Cstr(Year(CheckDate) ) ' Heiligabend - kein offizieller Feiertag
FName(9) = "Heiliger Abend"
FTag(10)= "25.12." + Cstr(Year(CheckDate) ) ' 1. Weihnachtsfeiertag
FName(10) = "1. Weihnachtsfeiertag"
FTag(11)= "26.12." + Cstr(Year(CheckDate) ) ' 2. Weihnachtsfeiertag
FName(11) = "2. Weihnachtsfeiertag"
FTag(12)= "31.12." + Cstr(Year(CheckDate) ) ' Sylvester - kein offizieller Feiertag
FName(12) = "Sylvester"
' Die beweglichen Feiertage
OsterDatum = Ostersonntag(Cint(Jahr))
' Rosenmontag
FTag(13)= Str(Datevalue(OsterDatum)-48) ' kein offizieller Feiertag
FName(13) = "Rosenmontag"
' Faschingsdienstag
FTag(14)= Str(Datevalue(OsterDatum)-47) ' kein offizieller Feiertag
FName(14) = "Faschingsdienstag"
' Karfreitag
FTag(15)= Str(Datevalue(OsterDatum)-2)
FName(15) = "Karfreitag"
' Ostersonntag
FTag(16)= Str(Datevalue(OsterDatum)-0)
FName(16) = "Ostersonntag"
' Ostermontag
FTag(17)= Str(Datevalue(OsterDatum)+1)
FName(17) = "Ostermontag"
' Himmelfahrt
FTag(18)= Str(Datevalue(OsterDatum)+39)
FName(18) = "Christi Himmelfahrt"
' Pfingstsonntag
FTag(19)= Str(Datevalue(OsterDatum)+49)
FName(19) = "Pfingstsonntag"
' Pfingstmontag
FTag(20)= Str(Datevalue(OsterDatum)+50)
FName(20) = "Pfingstmontag"
' Fronleichnam
FTag(21)= Str(Datevalue(OsterDatum)+60) ' - BaWü. , Bay, Hes, NRW. , RhPf. , Saar. und teilweise Thür.
FName(21) = "Fronleichnam"
'Msgbox FTag(14)
For cd = 1 To Ubound(FTag)
If CheckDate = FTag(cd) Then
' Feiertag="F" ' # als Flag verwendbar
Feiertag = FName(cd)
End If
Next
End Function
Ich habe noch weitere Funktionen und Klassen zum Datums-Handling, die auf diesen Funktionen aufsetzen, falls Interesse besteht...
ata