vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
SEPA-Dateien erstellen inkl. IBAN-, BLZ-/Kontonummernprüfung  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Datum/Zeit und Timer · Datums- und Zeitfunktionen   |   VB-Versionen: VB5, VB608.07.04
65 Feiertage berechnen

Berechnet 65 Feiertage (Christliche, Gedenktage, ...)

Autor:   Steffen StamprathBewertung:     [ Jetzt bewerten ]Views:  48.371 
www.bluedeveloper.deSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Mit nachfolgendem Code lassen sich insgesamt 65 Feiertage berechnen.

Erstellen Sie ein neues Projekt, platzieren auf die Form eine ListBox und einen CommandButton, und fügen nachfolgenden Code in den Codeteil der Form ein.

Option Explicit
 
Private Type TypeFeiertag
  NameA As String
  DatumA As Date
End Type
' alle Feiertage berechnen
Private Sub GetAlleFeiertag(JahrA As Long, FeiertagA() As TypeFeiertag)
  Dim a, b, c, d, e, f, s As Long
  Dim M, N As Long
  Dim OsternA As Date
  ReDim FeiertagA(64)
 
  FeiertagA(0).NameA = "4. Advent"
  FeiertagA(0).DatumA = GetViertenAdvent(JahrA)
 
  FeiertagA(1).NameA = "3. Advent"
  FeiertagA(1).DatumA = DateAdd("d", -7, GetViertenAdvent(JahrA))
 
  FeiertagA(2).NameA = "2. Advent"
  FeiertagA(2).DatumA = DateAdd("d", -14, GetViertenAdvent(JahrA))
 
  FeiertagA(3).NameA = "1. Advent"
  FeiertagA(3).DatumA = DateAdd("d", -21, GetViertenAdvent(JahrA))
 
  FeiertagA(4).NameA = "Totensonntag"
  FeiertagA(4).DatumA = DateAdd("d", -28, GetViertenAdvent(JahrA))
 
  FeiertagA(5).NameA = "Volkstrauertag"
  FeiertagA(5).DatumA = DateAdd("d", -35, GetViertenAdvent(JahrA))
 
  FeiertagA(6).NameA = "Buß- und Bettag"
  FeiertagA(6).DatumA = DateAdd("d", -11, FeiertagA(3).DatumA)
 
  FeiertagA(7).NameA = "Muttertag"
  FeiertagA(7).DatumA = GetMuttertag(JahrA)
 
  FeiertagA(8).NameA = "Erntedankfest"
  FeiertagA(8).DatumA = GetErntedankfest(JahrA)
 
  FeiertagA(9).NameA = "Neujahr"
  FeiertagA(9).DatumA = "01.01." & JahrA
 
  FeiertagA(10).NameA = "Heiligen drei Könige"
  FeiertagA(10).DatumA = "06.01." & JahrA
 
  FeiertagA(11).NameA = "Maifeiertag"
  FeiertagA(11).DatumA = "01.05." & JahrA
 
  FeiertagA(12).NameA = "Tag der Deutschen Einheit"
  FeiertagA(12).DatumA = "03.10." & JahrA
 
  FeiertagA(13).NameA = "Heiligabend"
  FeiertagA(13).DatumA = "24.12." & JahrA
 
  FeiertagA(14).NameA = "1. Weihnachtstag"
  FeiertagA(14).DatumA = "25.12." & JahrA
 
  FeiertagA(15).NameA = "2. Weihnachtstag"
  FeiertagA(15).DatumA = "26.12." & JahrA
 
  FeiertagA(16).NameA = "Silvester"
  FeiertagA(16).DatumA = "31.12." & JahrA
 
  FeiertagA(17).NameA = "Reformationstag"
  FeiertagA(17).DatumA = "31.10." & JahrA
 
  FeiertagA(18).NameA = "Allerheiligen"
  FeiertagA(18).DatumA = "01.11." & JahrA
 
  FeiertagA(19).NameA = "Maria Himmelfahrt"
  FeiertagA(19).DatumA = "15.08." & JahrA
 
  FeiertagA(20).NameA = "Valentinstag"
  FeiertagA(20).DatumA = "14.02." & JahrA
 
  FeiertagA(21).NameA = "Tag der Arbeit"
  FeiertagA(21).DatumA = "01.05." & JahrA
 
  FeiertagA(22).NameA = "Friedensfest"
  FeiertagA(22).DatumA = "08.08." & JahrA
 
  FeiertagA(23).NameA = "Nikolaus"
  FeiertagA(23).DatumA = "06.12." & JahrA
 
  a = JahrA Mod 19
  b = JahrA Mod 4
  c = JahrA Mod 7
  M = Val(((8 * Val(JahrA / 100) + 13) / 25) - 2)
  s = Val(JahrA / 100) - Val(JahrA / 400) - 2
  M = (15 + s - M) Mod 30
  N = (6 + s) Mod 7
  d = (M + 19 * a) Mod 30
  If d = 29 Then
  d = 28
  ElseIf d = 28 Then
      If (JahrA Mod 19) > 10 Then d = 27
  End If
  e = (2 * b + 4 * c + 6 * d + N) Mod 7
  OsternA = Format$(DateAdd("d", (d + e + 1), "21.03." & JahrA), "dd.mm.yyyy")
 
  FeiertagA(24).NameA = "Ostersonntag"
  FeiertagA(24).DatumA = OsternA
 
  FeiertagA(25).NameA = "Ostermontag"
  FeiertagA(25).DatumA = DateAdd("d", 1, OsternA)
 
  FeiertagA(26).NameA = "Karfreitag"
  FeiertagA(26).DatumA = DateAdd("d", -2, OsternA)
 
  FeiertagA(27).NameA = "Pfingstsonntag"
  FeiertagA(27).DatumA = DateAdd("d", 49, OsternA)
 
  FeiertagA(28).NameA = "Pfingstmontag"
  FeiertagA(28).DatumA = DateAdd("d", 50, OsternA)
 
  FeiertagA(29).NameA = "Christi Himmelfahrt"
  FeiertagA(29).DatumA = DateAdd("d", 39, OsternA)
 
  FeiertagA(30).NameA = "Aschermittwoch"
  FeiertagA(30).DatumA = DateAdd("d", -46, OsternA)
 
  FeiertagA(31).NameA = "Fronleichnam"
  FeiertagA(31).DatumA = DateAdd("d", 60, OsternA)
 
  FeiertagA(32).NameA = "Herz-Jesu-Freitag"
  FeiertagA(32).DatumA = DateAdd("d", 68, OsternA)
 
  FeiertagA(33).NameA = "Rosenmontag"
  FeiertagA(33).DatumA = DateAdd("d", -48, OsternA)
 
  FeiertagA(34).NameA = "Eisheiligen: Mamertus"
  FeiertagA(34).DatumA = "11.05." & JahrA
 
  FeiertagA(35).NameA = "Eisheiligen: Pankratius"
  FeiertagA(35).DatumA = "12.05." & JahrA
 
  FeiertagA(36).NameA = "Eisheiligen: Servatius"
  FeiertagA(36).DatumA = "13.05." & JahrA
 
  FeiertagA(37).NameA = "Eisheiligen: Bonifatius"
  FeiertagA(37).DatumA = "14.05." & JahrA
 
  FeiertagA(38).NameA = "Eisheiligen: kalte Sophie"
  FeiertagA(38).DatumA = "15.05." & JahrA
 
  FeiertagA(39).NameA = "Weiber Fastnacht"
  FeiertagA(39).DatumA = DateAdd("d", -52, OsternA)
 
  FeiertagA(40).NameA = "Fastnacht"
  FeiertagA(40).DatumA = DateAdd("d", -47, OsternA)
 
  FeiertagA(41).NameA = "Beginn der Sommerzeit"
  FeiertagA(41).DatumA = GetBeginnSommerzeit(JahrA)
 
  FeiertagA(42).NameA = "Beginn der Winterzeit"
  FeiertagA(42).DatumA = GetBeginnWinterzeit(JahrA)
 
  FeiertagA(43).NameA = "Winteranfang"
  FeiertagA(43).DatumA = "21.12." & JahrA
 
  FeiertagA(44).NameA = "Frühlingsanfang"
  FeiertagA(44).DatumA = "20.03." & JahrA
 
  FeiertagA(45).NameA = "Sommeranfang"
  FeiertagA(45).DatumA = "21.06." & JahrA
 
  FeiertagA(46).NameA = "Herbstanfang"
  FeiertagA(46).DatumA = "22.09." & JahrA
 
  FeiertagA(47).NameA = "Tag des Gedenkens an die Opfer des Nationalsozialismus"
  FeiertagA(47).DatumA = "27.01." & JahrA
 
  FeiertagA(48).NameA = "Unbefleckte Empfängnis Mariens"
  FeiertagA(48).DatumA = "08.12." & JahrA
 
  FeiertagA(49).NameA = "Darstellung des Herrn"
  FeiertagA(49).DatumA = "02.02." & JahrA
 
  FeiertagA(50).NameA = "Joseftag"
  FeiertagA(50).DatumA = "19.03." & JahrA
 
  FeiertagA(51).NameA = "Verkündigung des Herrn"
  FeiertagA(51).DatumA = "25.03." & JahrA
 
  FeiertagA(52).NameA = "Geburt Johannes des Täufers"
  FeiertagA(52).DatumA = "24.06." & JahrA
 
  FeiertagA(53).NameA = "Fest der Apostel Petrus und Paulus"
  FeiertagA(53).DatumA = "29.06." & JahrA
 
  FeiertagA(54).NameA = "Mariä Heimsuchung"
  FeiertagA(54).DatumA = "02.07." & JahrA
 
  FeiertagA(55).NameA = "Verklärung des Herrn"
  FeiertagA(55).DatumA = "06.08." & JahrA
 
  FeiertagA(56).NameA = "Kreuzerhöhung"
  FeiertagA(56).DatumA = "14.09." & JahrA
 
  FeiertagA(57).NameA = "Fest der Erzengel Michael, Gabriel und Raphael"
  FeiertagA(57).DatumA = "29.09." & JahrA
 
  FeiertagA(58).NameA = "Allerseelen"
  FeiertagA(58).DatumA = "2.11." & JahrA
 
  FeiertagA(59).NameA = "Weißer Sonntag"
  FeiertagA(59).DatumA = DateAdd("d", 7, OsternA)
 
  FeiertagA(60).NameA = "Johannistag"
  FeiertagA(60).DatumA = "24.06." & JahrA
 
  FeiertagA(61).NameA = "Siebenschläfertag"
  FeiertagA(61).DatumA = "27.06." & JahrA
 
  FeiertagA(62).NameA = "Gründonnerstag"
  FeiertagA(62).DatumA = DateAdd("d", -3, OsternA)
 
  FeiertagA(63).NameA = "Karsamstag"
  FeiertagA(63).DatumA = DateAdd("d", -1, OsternA)
 
  FeiertagA(64).NameA = "Europatag"
  FeiertagA(64).DatumA = "05.05." & JahrA
End Sub
' Beginn der Sommerzeit berechnen
Private Function GetBeginnSommerzeit(JahrA As Long) As Date
  Dim i As Long
 
  For i = 31 To 20 Step -1
    If Format$(i & ".3." & JahrA, "ddd") = "So" Then
      GetBeginnSommerzeit = i & ".3." & JahrA
      Exit For
    End If
  Next i
End Function
' Beginn der Winterzeit berechnen
Private Function GetBeginnWinterzeit(JahrA As Long) As Date
  Dim i As Long
 
  For i = 31 To 20 Step -1
    If Format$(i & ".10." & JahrA, "ddd") = "So" Then
      GetBeginnWinterzeit = i & ".10." & JahrA
      Exit For
    End If
  Next i
End Function
' Erntedank berechnen
Private Function GetErntedankfest(JahrA As Long) As Date
  Dim i As Long
 
  For i = 1 To 16
    If Format$(i & ".10." & JahrA, "ddd") = "So" Then
      GetErntedankfest = Format$(i & ".10." & JahrA, "dd.mm.yyyy")
      Exit For
    End If
  Next i
End Function
' Muttertag berechnen
Private Function GetMuttertag(JahrA As Long) As Date
  Dim W1 As Boolean
  Dim i As Long
 
  W1 = False
  For i = 1 To 31
    If Format$(i & ".5." & JahrA, "ddd") = "So" Then
      If W1 = True Then
        GetMuttertag = Format$(i & ".5." & JahrA, "dd.mm.yyyy")
        Exit For
      Else
        W1 = True
      End If
    End If
  Next i
End Function
' 4. Advent berechnen
Private Function GetViertenAdvent(JahrA As Long) As Date
  Dim i As Long
 
  For i = 24 To 1 Step -1
    If Format$(i & ".12." & JahrA, "ddd") = "So" Then
      GetViertenAdvent = Format$(i & ".12." & JahrA, "dd.mm.yyyy")
      Exit For
    End If
  Next i
End Function

Alle Feiertage in der ListBox anzeigen

Private Sub Command1_Click()
  ' alle Feiertage in einer ListBox anzeigen
  Dim FeiertageA() As TypeFeiertag
  Dim i As Long
 
  GetAlleFeiertag 2004, FeiertageA()
  For i = 0 To 64
    List1.AddItem FeiertageA(i).DatumA & "   " & FeiertageA(i).NameA
  Next i
End Sub

Dieser Tipp wurde bereits 48.371 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 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