Code VBA - Tiggi

Tiggi_Logo
Direkt zum Seiteninhalt

Code VBA

Software
Feiertage
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 Ostern abhängig und diverse andere Feiertage sind jeweils an einem Sonntag im Monat (z.B. 3. Sontag im September).

 
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 die Spalte A mit einem aufsteigendes Datum (Kalender) versehen ist.
In der Spalte B kann nun durch die beiden hier präsentierten Funktionen die Feiertage  oder der Name des Tages eingetragen werden.
Das Bild zeigt nun das Resultat der Funktion Feiertage.
Das folgende Codeschnibsel erledigt diese Aufgabe.
 
   ' Feiertage eintragen
 
   Ostern = OsterSonntag(Jahr)
   For i = lngR To lngR + 370
       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)
   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)
           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"
       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
Alter berechnen
Um das Alter zu berechnen verwendet man in Excel die Funktion
 
BRTEILJAHRE(Anfang, Ende, Basis)
 
Die Basis kann in unserem Beispiel weggelassen werden (beliebig). Als Anfang wählt man das Geburtsdatum und als Ende das aktuelle Datum.
Für das aktuelle Datum eignet sich die Formel „=Heute()“ dadurch wird immer genau das aktuelle Datum aus der Computeruhr angewendet.
 
In einer Excel-Tabelle sieht das dann so aus;




Als Code in VBA sieht die Funktion wie folgt aus:

Public Function Alter(GebDatum) As Long
  Alter = Year(Date) - Year(GebDatum)
  If DateSerial(Year(Date), Month(GebDatum), Day(GebDatum)) > Date Then
    Alter = Alter - 1
  End If
End Function

Da es als Funktion definiert ist kann das Alter direkt einer Variablen zugeordnet werden:

Dim lngAlter as Long
lngAlter = Alter(08.05.1949)

AdressTel
HTML hit counter - Quick-counter.net
Zurück zum Seiteninhalt