VB 5/6-Tipp 0344: Berechnung von Feiertagen

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2" (Index von 0 bis 1)
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1" (Index von 0 bis 4)
' Steuerelement: Beschriftungsfeld "Label2" (Index von 0 bis 4)


'Autor: Lothar Kriegerow
'E-Mail: lausitz@t-online.de

Option Explicit

Private Sub Command1_Click()
    Dim GDatum As Date
    Dim a As Long, b As Long, c As Long
    Dim d As Long, e As Long, f As Long
    Dim g As Long, h As Long, i As Long
    Dim k As Long, l As Long, m As Long
    Dim Wert As Long, Monat As Long
    Dim Datum As Long, Jahr As Long
    
    Jahr = Val(Text1)
    If Jahr < 1580 Then Exit Sub
    Jahr = Text1
    
    'Osterformel nach Gauß
    a = Jahr Mod 19
    b = Jahr \ 100
    c = Jahr Mod 100
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    i = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * i - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    Wert = h + l - 7 * m + 22
    Monat = 3 - (Wert > 31)
    Datum = Wert + 31 * (Wert > 31)
    GDatum = DateSerial(Jahr, Monat, Datum)
    
    Label1(0) = DateAdd("d", GDatum, -47)
    Label1(1) = GDatum
    Label1(2) = DateAdd("d", GDatum, 39)
    Label1(3) = DateAdd("d", GDatum, 49)
    Label1(4) = DateAdd("d", GDatum, 60)
End Sub

Private Sub Command2_Click(i As Integer)
    Select Case i
        Case 0
            If Text1 > 1560 Then Text1 = Text1 - 1
            
        Case 1
            Text1 = Text1 + 1
    End Select
End Sub


'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von FelixS am 12.06.2008 um 18:01

Bei meinem Geburtstag
versagt es aber völlig ;)

Kommentar von Marcel Kamenzin am 05.08.2003 um 12:08

GDatum = Tag & "." & Monat + "." & Jahr
sollte durch
GDatum = DateSerial(Jahr, Monat, Tag)
ersetzt werden.
Sonst funktioniert es nicht mit anderen Ländereinstellungen.

Kommentar von Jörg am 05.07.2003 um 12:47

Kleine Verbesserung der Function:

Function OSTERN(JAHR As Long) As Date
    a& = JAHR Mod 19
    b& = JAHR \ 100
    c& = JAHR Mod 100
    d& = b \ 4
    e& = b Mod 4
    f& = (b + 8) \ 25
    g& = (b - f + 1) \ 3
    h& = (19 * a + b - d - g + 15) Mod 30
    i& = c \ 4
    k& = c Mod 4
    l& = (32 + 2 * e + 2 * i - h - k) Mod 7
    m& = (a + 11 * h + 22 * l) \ 451
    wert& = h + l - 7 * m + 22
    monat& = 3 - (wert > 31)
    datum& = wert + 31 * (wert > 31)
    OSTERN = DateSerial(JAHR, monat, datum)
End Function

Gruß Jörg

Kommentar von Jörg Pockrandt am 08.04.2003 um 18:23

Hier ist die unten erwähnte Function zur Feiertagsberechnung zum Kopieren und Einfügen in ein Excel-Modul z.B.:

Function OSTERN(JAHR As Integer, RÜCKGABE As Integer) As Integer
'
' RÜCKGABE:
' 0 -> Tagesdatum
' 1 -> Monat
'
a = JAHR Mod 19
b = JAHR \ 100
c = JAHR Mod 100
d = b \ 4
e = b Mod 4
f = (b + 8) \ 25
g = (b - f + 1) \ 3
h = (19 * a + b - d - g + 15) Mod 30
i = c \ 4
k = c Mod 4
l = (32 + 2 * e + 2 * i - h - k) Mod 7
m = (a + 11 * h + 22 * l) \ 451
wert = h + l - 7 * m + 22
If wert > 31 Then
monat = 4
datum = wert - 31
Else
monat = 3
datum = wert
End If
If RÜCKGABE = 0 Then
OSTERN = datum
Else
OSTERN = monat
End If
End Function

Kommentar von Jörg Pockrandt am 07.04.2003 um 13:40

Hallo VB-Freunde,
unter dem Link
http://www.serve.com/jb/ostern.htm
gibt es mehrere Formeln zur Feiertagsberechnung. Die letzte aus der Turbo-Pascal-FAQ ist die einfachste und funktioniert genauso wie die von Gauß.
Tipp: Das DIV steht für Ganzahldivision und kann durch INT ersetzt werden, oder einfach statt "/" "\" einsetzen!

Kommentar von Peter Obier am 16.10.2002 um 03:36

Hallo Herr Kriegerow,
ich komme beim Aufruf "Command2_Click(I as Integer) nicht klar. Welcher Wert "I" wird hier übergeben ? Ich bekomme dabei eine Fehlermeldung "Deklaration der Beschreibung entspricht nicht..." usw. Würde mich über eineAntwort freuen. Ansonsten spielen die Feiertage. Danke und Tschüß
P. Obier

Kommentar von Peach am 19.04.2002 um 23:40

Int(J/100) kommt in der Formel unzählige Male vor. Es dürfte schneller sein, dies vorgängig in eine eigene Variable zu speichern, das spart auch noch einige Klammern.
Für was das 'n' steht ist mir auch nicht klar.
Jh = Int(J / 100)
I1 = (Jh - Int(Jh / 4) - Int((Jh - (Int((Jh - 17) / 25))) / 3) + 19 * (J - 19 * Int(J / 19)) + 15)
I2 = I1 - 30 * Int((Jh - Int(Jh / 4) - Int((Jh - (Int((Jh - 17) / 25))) / 3) + 19 * (J - 19 * Int(J / 19)) + 15) / 30)
I3 = I2 - Int(I2 / 28) * (1 - Int(I2 / 28) * Int(29 / (I2 + 1)) * Int((21 - n) / 11))
A2 = (J + Int(J / 4) + I3 + 2 - Jh + Int(Jh / 4)) - 7 * Int((J + Int(J / 4) + I3 + 2 - Jh + Int(Jh / 4)) / 7)

Kommentar von Jens Kutsche am 12.03.2002 um 15:33

- Die Berechnung von I2 kann man erheblich verkürzen, da die ersten 4 Zeilen bis "- 30" dem I1 entsprechen.
- Wofür steht das "n" in der Formel in "I3"? "n" wird nicht initialisiert.

Kommentar von Elac7 am 18.04.2001 um 14:12

Mist - jetzt sieht es so aus als ob die Formel in 5.) nur bis 2078 korrekt arbeitet.....
Leider kann man hier nichts korrigieren!
Also RICHTIGSTELLUNG:
Die Formel unter 3.) arbeitet nur bis 2078 korrekt
Die Formel unter 5.) ARBEITET IMMER KORREKT

Kommentar von Elac7 am 18.04.2001 um 14:08

Die unten angeführte Formel arbeitet nur bis zum Jahr 2078 korrekt (bin gerade draufgekommen). Hier eine Formel die man als AddIn für Excel benutzen kann und natürlich auch ins VB übernehmen kann.
Function OSTERN(SuchJahr As Integer) As Date
Dim n, a, u_b, m, q, w, o, p As Integer
n = SuchJahr - 1900
a = n - Fix(n / 19) * 19
u_b = Fix((7 * a + 1) / 19)
m = (11 * a + 4 - u_b) - Fix((11 * a + 4 - u_b) / 29) * 29
q = Fix(n / 4)
w = (n + q + 31 - m) - Fix((n + q + 31 - m) / 7) * 7
o = 25 - m - w
p = 4
If o

Kommentar von Elac7 am 18.04.2001 um 03:48

Ups - Jahr muß in A1 stehen!!!!

Kommentar von Elac7 am 18.04.2001 um 03:47

In Excel funktioniert das:
=DM((TAG(MINUTE(A1/38)/2+55)&".4."&A1)/7;)*7-6

Kommentar von Manfred am 31.03.2001 um 16:09

http://www.google.com/search?q=ostern+gau%DF&hl=de&lr=

Kommentar von Marius Hennecke am 24.01.2001 um 15:21

Gibt es vielleicht zu dieser Osterformel von Gauß irgendwo eine Seite im Netz, die diese etwas naeher erlaeutert?