vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2025
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Allgemeine Diskussionen
Re: Bewegliche Feiertage berechnen 
Autor: me36835
Datum: 04.06.04 12:06

Hallo Chrissy,

bew - Name der Funktion
Jahr - das Jahr
Feiertag - Für jeden beweglichen Feiertag gibt es hier einen Kennbuchstaben
Rückgabe - Datum des gesuchten Feiertags im übergebenen Jahr

Public Function bew(ByVal Jahr As Integer, ByVal Feiertag As String)
Dim OM, OT, M, N, a, b, c, d, E As Integer
' http://www.salesianer.de/util/kalfaq.html#B2
' B.2 Wie kann man überhaupt die beweglichen Feste berechnen?
' Das Schwierigste ist sicher die Berechnung des Osterfestes. Diese Seite 
' verwendet dazu die Gauß'sche Osterformel, angewendet auf den Julianischen _
bzw. Gregorianischen Kalender. Auf den Seiten der PTB kann man die Osterformel _
nachlesen. Näheres zur Osterfestberechnung siehe auch unter Frage B.7.
' Die Ostkirchen (mit Ausnahme eines Teils der unierten Kirchen) haben heute 
' allerdings einen anderen Ostertermin, da sie die gregorianische 
' Kalenderreform nicht mitgemacht haben. Ferner haben in der Aufklärungszeit 
' einige protestantische Kirchen (auch in Deutschland) vorübergehend eine 
' andere Art der Berechnung des Ostertermins verwendet, so dass sie in einigen 
' wenigen Fällen Ostern an einem anderen Datum feierten.
' -----------------------------------------------------------------------------
' -----------------------------------------------------------------------------
' -------------------------------
' Verwendeter Algorithmus zur Errechnung des Osterdatums (BASIC-Darstellung, 
' alle Variablen integer oder long):
' http://www.uni-bamberg.de/ktheo/liturgie/@fkal.html#algorithmus
Select Case Jahr
    Case 1700 To 1799
        M = 23: N = 3
    Case 1800 To 1899
        M = 23: N = 4
    Case 1900 To 2099
        M = 24: N = 5
    Case 2100 To 2199
        M = 24: N = 6
    Case Else
        bew = "Syntax(yyyy,'t')"
        Exit Function
End Select
a = Jahr Mod 19: b = Jahr Mod 4: c = Jahr Mod 7: d = (19 * a + M) Mod 30
E = (2 * b + 4 * c + 6 * d + N) Mod 7
' ^^^ OM= Monat des Ostersonntags
OM = 3
' ^^^ OT=Tag des Ostersonntags
OT = 22 + d + E
If OT > 31 Then
    OT = OT - 31
    OM = 4
    If OT = 26 Then OT = 19
    If OT = 25 And d = 28 And a > 10 Then OT = 18
End If
bew = DateValue(str(OT) & "/" & str(OM) & "/" & str(Jahr))
Select Case Feiertag
    Case "1" ' 1. Advent
        bew = CDate("25/12/" & str(Jahr))
        bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
        bew = bew - 21
    Case "2" ' 2. Advent
        bew = CDate("25/12/" & str(Jahr))
        bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
        bew = bew - 14
    Case "3" ' 3. Advent
        bew = CDate("25/12/" & str(Jahr))
        bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
        bew = bew - 7
    Case "4" ' 4. Advent
        bew = CDate("25/12/" & str(Jahr))
        bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
    Case "a" ' Aschermittwoch (-46)
        bew = bew - 46
    Case "b" ' Buß- & Bettag
        bew = CDate("25/12/" & str(Jahr))
        bew = bew - WeekDay("25/12/" & str(Jahr), vbMonday)
        bew = bew - 32
    Case "c" ' Christi Himmelfahrt (+39)
        bew = bew + 39
    Case "f" ' Fronleichnam (+60)
        bew = bew + 60
    Case "h" ' Herz-Jesu-Freitag (+68)
        bew = bew + 68
    Case "k" ' Karfreitag (-2)
        bew = bew - 2
    Case "m" ' Pfingstmontag (+50)
        bew = bew + 50
    Case "o" ' Ostermontag (+1)
        bew = bew + 1
    Case "p" ' Pfingstsonntag (+49)
        bew = bew + 49
    Case "r" ' Rosenmontag (-48)
        bew = bew - 48
    Case "s" ' Ostersonntag (+-0)
        bew = bew
    Case "w" ' Weiberfastnacht (-52)
        bew = bew - 52
    Case Else
        bew = "Syntax(yyyy,'t'); t is" & vbLf & _
                "a - Aschermittwoch" & vbLf & _
                "b - Buß- & Bettag" & vbLf & _
                "c - Christi Himmelfahrt" & vbLf & _
                "f - Fronleichnam" & vbLf & _
                "h - Herz-Jesu-Freitag" & vbLf & _
                "k - Karfreitag" & vbLf & _
                "m - Pfingstmontag" & vbLf & _
                "o - Ostermontag" & vbLf & _
                "p - Pfingstsonntag" & vbLf & _
                "r - Rosenmontag" & vbLf & _
                "s - Ostersonntag" & vbLf & _
                "w - Weiberfastnacht"
End Select
' Der Muttertag ist der zweite Sonntag im Mai
' Erntedankfest der erste Sonntag im Oktober (jedoch nicht überall!)
' Der 1. Advent ist der Sonntag nach dem 26. November
' der Buß- und Bettag liegt 11 Tage vor dem 1. Advent.
' Beginn der Sommerzeit in der EU ist der letzte Sonntag im März
' Beginn der Sommerzeit in USA ist der erste Sonntag im April
' Ende Sommerzeit ist der erste Sonntag im Oktober
' Wobei J = Jahreszahl(vierstellig)
' Der Algorithmus geht auf den Mathematiker und Astronomen Carl Friedrich Gauß ( 
' 1777-1855) zurück.
End Function
alle Nachrichten anzeigenGesamtübersicht  |  Zum Thema  |  Suchen

 ThemaViews  AutorDatum
Feiertage mit Outlook ermitteln1.444chrissy04.06.04 08:30
Re: Feiertage mit Outlook ermitteln1.209me3683504.06.04 10:05
Re: Feiertage mit Outlook ermitteln930chrissy04.06.04 11:42
Re: Feiertage mit Outlook ermitteln1.023me3683504.06.04 13:06
Re: Feiertage mit Outlook ermitteln989chrissy04.06.04 13:57
Re: Feiertage ohne Outlook ermitteln924me3683504.06.04 11:57
Re: Bewegliche Feiertage berechnen3.597me3683504.06.04 12:06

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel