Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung
Autor:   Hermann Röttger	Bewertung:     [ Jetzt bewerten ]	Views:  17.554
www.direct-solutions-software.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 21 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Vor einigen Monaten veröffentlichte ich den Beitrag  Bewegliche Feiertage und Arbeitstage eines Monats, in dem beschrieben wird, wie man Ostern und andere bewegliche Feiertage berechnen kann. Ich war offenbar nicht der einzige, der sich für diese Thematik interessierte, denn ich erhielt zahlreiche Anfragen und Anregungen, die sich zumeist alle um den doch recht verzwickten Bereich "Datums-und Zeitberechnungen" drehten. Da ich nicht die Zeit hatte, auf alle Mails ausführlich zu antworten, möchte ich euch - quasi als Ausgleich - heute einen "Dreh" vorstellen, der auf die Feiertagsberechnung zurückgreift und mir schon des öfteren geholfen hat.

Es geht, schlicht gesagt, um das "Zählen von benutzerdefinierten Wochentagen innerhalb von benutzerdefinierten Zeiträumen". Das Problem tauchte bei mir vor einigen Jahren zum ersten Mal auf, als ich für einen Kunden eine "dynamische" Rechnungsvorlage in Excel erstellte, dynamisch deshalb, weil sie nach Änderung von 2 Zeitparameteren (DatumVon, DatumBis) automatisch berechnen sollte, wie viele Montage, Dienstage etc (je nach Rechnungsposten) ein bestimmter Zeitraum unter Berücksichtigung von festen und beweglichen Feiertagen aufwies. Also "strickte" ich mir 2 Funktionen, durch die sich diese Aufgabe - insbesondere in Excel - sehr leicht und variabel lösen lässt.

Die erste Funktion wandelt als Text eingetragene Wochentag-Kürzel ("Mo", "Di" etc.) in die VB-Wochentag-Numeration (also z.B. 2 für Montag) um. Es können

• einzelne Wochentage (z.B. "Mo")
• mehrere Wochentage (z.B. "Mo, Mi, Fr")
• zusammenhängende Wochentage (z.B. "Mo-Do" für "Montag bis Freitag")
• oder aber auch Kombinationen (z.B, "Mo-Do, Sa" für "Montag bis Freitag UND Samstag)

Dieser Teil ist also sehr auf Excel gemünzt und soll die Parametereingabe bei der Nutzung als Excel-Formel so einfach wie möglich machen.
Die Excel-Formel würde dann z.B. so aussehen:

=WTSTR(A1;A2;"Mo-Fr")

"Start-und Zieldatum" würden hier in A1 und A2 stehen.
Optional kann man noch den Boolschen Wert "FT_Mitzählen" übergeben, der standardmäßig auf "True" gesetzt ist (Feiertage werden also mitgezählt). Sollen Wochentage nur dann gezählt werden, wenn sie nicht gleichzeitig ein Feiertag sind, wird hier entspr. "False" übergeben, also z.B in Excel:

=WTSTR(A1:A2;"Mo-Fr";0)

Die zweite Funktion führt hingegen die eigentliche Berechnung durch und entstand lange vor der "Excel-Umsetzung".

Hier nun der Quellcode zur "Excel-Funktion". Ich habe mir mal die Mühe gemacht und alles hinreichend kommentiert:

Public Function WTstr(ByVal Startdatum As Date, _
  ByVal Zieldatum As Date, _
  ByVal WTtext As String, _
  Optional ByVal FT_Mitzählen As Boolean = True) As Variant
 
  ' Hilfsvariablen, u.a. für Schleifen
  Dim I As Integer
  Dim I2 As Integer
 
  ' Start und Ziel-Index bei mehreren Tagen
  Dim Von As Integer
  Dim Bis As Integer
 
  ' Boolsche Variablen, in denen gespeichert wird, 
  ' welche Wochentage gezählt werden sollen
  Dim W(7) As Boolean
 
  ' Statusflag, das festlegt, ob die Funktion korrekt durchgeführt werden kann
  ' falls FALSE, wird ein Fehlerhinweis zurückgegeben
  Dim OK As Boolean
 
  ' Undimensionierte Indizierte Variable, in deren Datenfeldern später die 
  ' einzelnen Parameterbereiche gespeichert werden
  Dim A() As String
 
  ' 1. Wurden mindestens 2 Zeichen (also mindestens ein einzelner Wochentag) übergeben ?
  If Len(WTtext) > 1 Then
    ' 1a. Ja
    ' Datenfelder von A mit Parametergruppen füllen, Gruppen müssen 
    ' durch ein Komma getrennt sein
    A = Split(WTtext, ",")
    ' Alle Parametergruppen durchlaufen
    For I = 0 To UBound(A)
      ' 1b. Enthält die Parametergruppe das Zeichen "-", mit dem 
      ' Wochentagbereiche (mehrere zusammenhängende Tage) beschrieben 
      ' werden (z.B. "Mo-Fr" für "Montag bis Freitag") ?
      If InStr(A(I), "-") Then
        ' Leerzeichen löschen
        A(I) = Trim(A(I))
        ' 1b. Ja, mehrere zusammenhängende Tage
        ' 1c. Kann das Wochentag-Kürzel,mit dem der erste Tag des
        ' Wochentag-Bereichs beschrieben wurde, identifiziert werden ?
        I2 = InStr(UCase("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1"), UCase(Left(A(I), 2)))
        If I2 > 0 Then
          ' 1c. Ja
          ' VBA-Index für ersten Tag ermitteln
          Von = CInt(Mid("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1", I2 + 2, 1))
          ' 1d. Kann das Wochentag-Kürzel,mit dem der letzte Tag des
          ' Wochentag-Bereichs beschrieben wurde, identifiziert werden ?
          I2 = InStr(UCase("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1"), UCase(Right(A(I), 2)))
          If I2 > 0 Then
            ' 1d. Ja
            ' VBA-Index für letzten Tag ermitteln
            Bis = CInt(Mid("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1", I2 + 2, 1))
            ' 1e. Wurde die Reihenfolge eingehalten (also z.B. nicht "So-So"
            ' oder "Do-Mo" übergeben) ?
            If Von < Bis Then
              ' 1e. Ja
              ' Entsprechende boolsche Variablen setzen
              OK = True
              For I2 = Von To Bis
                W(I2) = True
              Next I2
            Else
              ' 1e. Nein
              ' 1f. Ist Start-und Zieltag identisch ?
              If Von = Bis Then
                ' 1f. Ja
                ' Funktion kann nicht somit nicht korrekt ausgeführt werden
                OK = False
                GoTo Abbruch
              Else
                ' 1f. Nein
                ' 1g. Ist der letzte Wochentag ein Sonntag ?
                If Bis = 1 Then
                  ' 1g. Ja
                  ' Dann Funktion trotzdem zulassen (Sonntag hat den Wert 1
                  ' und würde nach dem angewendeten Schema sonst nicht
                  ' berücksichtigt werden
                  OK = True
                  ' "Ausnahme" setzen (Sonntag)
                  W(1) = True
                  ' andere entsprechende Boolsche Variablen setzen
                  For I2 = Von To 7
                    W(I2) = True
                  Next I2
                Else
                  ' 1g. Nein
                  ' Funktion kann nicht korrekt ausgeführt werden
                  OK = False
                  GoTo Abbruch
                End If
              End If
            End If
          Else
            ' 1d. Nein - letzter Tag kann nicht identifiziert werden
            ' Funktion kann somit nicht korrekt ausgeführt werden
            OK = False
            GoTo Abbruch
          End If
        Else
          ' 1c. Nein, erster Tag kann nicht identifiziert werden
          ' Funktion kann somit nicht korrekt ausgeführt werden
          OK = False
          GoTo Abbruch
        End If
      Else
        ' 2. Nein - einzelner Tag
        ' Leerzeichen löschen
        A(I) = Trim(A(I))
        ' 2b. '1c. Kann das Wochentag-Kürzel,mit dem der Tag des
        ' beschrieben wurde, identifiziert werden ?
        I2 = InStr(UCase("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1"), UCase(A(I)))
        If I2 > 0 Then
          ' 2b. Ja
          ' Entsprechende Boolsche Variable setzen
          OK = True
          W(CInt(Mid("Mo2,Di3,Mi4,Do5,Fr6,Sa7,So1", I2 + 2, 1))) = True
        Else
          ' 2b. Nein
          ' Funktion kann somit nicht ausgeführt werden
          OK = False
          GoTo Abbruch
        End If
      End If
    Next I
  Else
    ' 1a. Nein - Funktion kann somit nicht korrekt ausgeführt werden
    OK = False
  End If
 
Abbruch:
  ' Zähl-Funktion aufrufen ?
  If OK = True Then
    ' Ja
    WTstr = WT(Startdatum, Zieldatum, W(2), W(3), W(4), W(5), W(6), W(7), W(1))
  Else
    ' Nein, fehlerhafte Parameter zurückgeben
    WTstr = "#??" & WTtext
  End If
End Function

Wie ihr seht, wird am Ende der Funktion die Funktion "WT" aufgerufen, welche nun das eigentliche Zählen übernimmt:

Public Function WT(ByVal Startdatum As Date, _
  ByVal Zieldatum As Date, _
  Optional ByVal Montag As Boolean = False, _
  Optional ByVal Dienstag As Boolean = False, _
  Optional ByVal Mittwoch As Boolean = False, _
  Optional ByVal Donnerstag As Boolean = False, _
  Optional ByVal Freitag As Boolean = False, _
  Optional ByVal Samstag As Boolean = False, _
  Optional ByVal Sonntag As Boolean = False, _
  Optional ByVal FT_Mitzählen As Boolean = False) As Integer
 
  Dim I As Long
  Dim I2 As Byte
  Dim AT As Integer
 
  Dim Wochentage(7) As Boolean
 
  ' Index entsprechend des VBA-Index für Wochentage setzen
  Wochentage(2) = Montag
  Wochentage(3) = Dienstag
  Wochentage(4) = Mittwoch
  Wochentage(5) = Donnerstag
  Wochentage(6) = Freitag
  Wochentage(7) = Samstag
  Wochentage(1) = Sonntag
 
  ' Datumsbereich durchlaufen (äußere Schleife)
  For I = CLng(Startdatum) To CLng(Zieldatum)
    ' Wochentage durchlaufen (innere Schleife)
    For I2 = 1 To 7
      ' Stimmt der Wochentag-Index des aktuellen Tages der äußeren Schleife
      ' mit dem aktuellen Wert der inneren Schleife überein ?
      If Weekday(CDate(I)) = I2 Then
        ' Ja
        ' Soll dieser Wochentag gezählt werden ?
        If Wochentage(I2) = True Then
          ' Ja
          ' Soll dieser Wochentag auch dann gezählt werden,
          ' wenn er ein Feiertag ist ?
          If FT_Mitzählen = True Then
            ' Ja
            WT = WT + 1
          Else
            ' Nein, "Ostern"-Routine nutzen, um festzustellen,
            ' ob der Tag ein Feiertag ist
            AT = Arbeitstag(CDate(I))
            WT = WT + AT
          End If
        End If
      End If
    Next I2
  Next I
End Function

Hier nun die (für diesen Zweck modifizierte, also nicht die Orginal-Funktion aus dem "Feiertags-Beitrag" verwenden !!!)Funktion "Arbeitstag", welche berechnet, ob der übergebene Tag ein fester oder beweglicher Feiertag ist. Damit sie funktioniert, braucht ihr noch die Funktion "Ostern", welche ihr am Ende des Beitrags findet:

Public Function Arbeitstag(x As Date, _
  Optional SaSoMitzählen As Boolean = True) As Integer
 
  Dim Feiertage(12) As Date
  Dim Feiertag As String
  Dim Jahr As Integer
  Dim SaSo As Integer
  Dim i As Long
 
  ' Jahr aus übergebenem Datum ermitteln
  Jahr = CInt(Format(x, "yyyy"))
 
  ' Wochentag ermitteln
  SaSo = CInt(Weekday(x))
 
  ' Arbeitstag = 1 / normaler Werktag
  ' Arbeitstag = 0 / Samstag, Sonntag und/oder Feiertag
  Arbeitstag = 1
 
  ' Bewegliche Feiertage ermitteln
  ' Karfreitag
  Feiertage(1) = (Ostern(Jahr)) - 2
  ' Ostermontag
  Feiertage(2) = (Ostern(Jahr)) + 1
  ' Pfingstmontag
  Feiertage(3) = (Ostern(Jahr)) + 50
  ' Himmelfahrt
  Feiertage(4) = (Ostern(Jahr)) + 39
  ' Frohnleichnam
  Feiertage(5) = (Ostern(Jahr)) + 60
 
  ' Feste Feiertage ermitteln
  ' Neujahr
  Feiertage(6) = CDate("01.01." & Jahr)
  ' 1.Mai
  Feiertage(7) = CDate("01.05." & Jahr)
  ' Tag der deutschen Einheit
  Feiertage(8) = CDate("03.10." & Jahr)
  ' Allerheiligen
  Feiertage(9) = CDate("01.11." & Jahr)
  ' 1. Weihnachtstag
  Feiertage(10) = CDate("25.12." & Jahr)
  ' 2.Weihnachtstag
  Feiertage(11) = CDate("26.12." & Jahr)
 
  ' Stimmt das übergebene Datum mit einem der Feiertage überein ?
  For I = 1 To 11
    If x = Feiertage(I) Then
      ' Ja, kein Arbeitstag
      Arbeitstag = 0
      Exit For
    End If
  Next I
 
  If (SaSo = 1 Or SaSo = 7) And SaSoMitzählen = False Then
    Arbeitstag = 0
  End If
End Function

Public Function ArbeitsTage(x As Date) As Integer
  Dim Monat, Jahr, Tage, AT As Integer
  Dim S As Double
  Dim Schaltjahr As String
  Dim St, En As String
  Dim Start, Ende As Date
  Dim i As Long
 
  ' Tage des Monats ermitteln
  Monat = CInt(Format(x, "mm"))
  Jahr = CInt(Format(x, "yyyy"))
  S = Jahr / 4
  Schaltjahr = S
  If Monat = 1 Then Tage = 31
  If Monat = 2 Then
    If InStr(Schaltjahr, ",") > 0 Then
      ' Kein Schaltjahr
      Tage = 28
    Else
      ' Schaltjahr
      Tage = 29
    End If
  End If
  If Monat = 3 Then Tage = 31
  If Monat = 4 Then Tage = 30
  If Monat = 5 Then Tage = 31
  If Monat = 6 Then Tage = 30
  If Monat = 7 Then Tage = 31
  If Monat = 8 Then Tage = 31
  If Monat = 9 Then Tage = 30
  If Monat = 10 Then Tage = 31
  If Monat = 11 Then Tage = 30
  If Monat = 12 Then Tage = 31
 
  ' Start und Enddatum des Monats ermitteln
  St = "01." & Format(Monat, "00") & "." & Jahr
  Start = CDate(St)
  Ende = CDate(Start) + (Tage - 1)
 
  ' Arbeitstage ermitteln
  For I = Start To Ende
    AT = AT + Arbeitstag(CDate(I))
  Next I
  ArbeitsTage = AT
End Function

Last but not least die "Ostern-Funktion"

Public Function Ostern(x As Integer) As Date
  Dim K, M, S, D, R, A, OG, SZ, OE, OSI As Integer
  Dim OS1 As Double
  Dim OS2 As String
 
  K = Int(x / 100)
  M = 15 + Int((3 * K + 3) / 4) - Int((8 * K + 13) / 25)
  S = 2 - Int((3 * K + 3) / 4)
  A = x Mod 19
  D = (19 * A + M) Mod 30
  R = Int(D / 29) + (Int(D / 28) - Int(D / 29)) * Int(A / 11)
  OG = 21 + D - R
  SZ = 7 - (x + Int(x / 4) + S) Mod 7
  OE = 7 - (OG - SZ) Mod 7
  OSI = ((OG + OE) - 1)
  OS2 = "01.03." & x
  OS2 = CDate(OS2)
  OS1 = CDate(OS2)
  OS1 = CDbl(OS1)
  OS1 = OS1 + OSI
  OS1 = CDate(OS1)
  Ostern = OS1
End Function

So - das war ne' ganze Menge Quellcode.

Ich hoffe, das Anwendungsbeispiel wird euch bei eurer täglichen Arbeit helfen können.

Gruß
HR