Alle Tage zweier Datumswerte ermitteln Diese Beispiel zeigt, wie sich alle (bestimmten) Wochentage zwischen zwei Datumsangaben ermitteln lassen.
Autor:   Michael Becker	Bewertung:     [ Jetzt bewerten ]	Views:  21.412
ohne Homepage	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: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Die nachfolgende Funktion ermittelt die einzelnen Datumswerte zwischen Datum1 und Datum2.

Diese Funktion ist hilfreich, wenn der Anwender z.B. Urlaub vom 15.06.2001 - 08.07.2001 einträgt und Sie die einzelnen Tage in einem Kalender markieren möchten.

Oder (wenn wir schon beim Urlaub sind): Die Funktion kann ebenfalls sinnvoll genutzt werden, um alle Arbeitstage zwischen zwei beliebigen Datumsangaben zu ermitteln.

Die ersten beiden Parameter der Funktion Datumschleife müssen angegeben werden. Der dritte Parameter ist optional und legt die zu berücksichtigenden Wochentage fest (z.B. Mo,Di,Mi,Do,Fr). Wird der Parameter nicht angegeben, so werden alle Wochentage berücksichtigt.

Public Function Datumschleife(ByVal Datum_1 As String, _
  Datum_2 As String, _
  Optional ByVal WTage As Variant) As String
 
  Dim anzahltage As Long
  Dim starttag As String
  Dim ergebnis As String
  Dim einzeldatum As String
  Dim y As Integer
  Dim strTage As String
 
  ' wenn keine zu zählenden Wochentage angegeben wurden
  ' alle Wochentage berücksichtigen
  If IsMissing(WTage) Then WTage = ""
  If WTage = "" Then WTage = "Mo;Di;Mi;Do;Fr;Sa;So"
 
  If Datum_1 > "" And Datum_2 > "" Then
    ' Anzahl Tage zwischen Datum1 und Datum2 ermitteln
    anzahltage = DateDiff("D", Datum_1, Datum_2)
 
    ' Beginnen mit Datum1
    starttag = Datum_1
    For y = 0 To anzahltage
      einzeldatum = DateAdd("d", y, starttag)
      If IsDate(einzeldatum) = True Then
        ergebnis = Left(Format(einzeldatum, "dddd"), 2) & _
          ", " & Format(einzeldatum, "dd.mm.yyyy")
 
        ' Prüfen, ob ermittelter Wochentag berücksichtigt
        ' werden soll
        If InStr(WTage, Left$(ergebnis, 2)) > 0 Then
          strTage = strTage & ergebnis & ";"
        End If
      End If
    Next y
 
    ' unnötiges Semikolon entfernen
    If Right$(strTage, 1) = ";" Then _
      strTage = Left$(strTage, Len(strTage) - 1)
 
  ElseIf Datum_1 > "" And Datum_2 = "" Then
    ' Einzelner Tag
    If IsDate(Datum_1) = True Then
      ergebnis = Left(Format(CDate(Datum_1), "dddd"), 2) & _
        ", " & Format(einzeldatum, "dd.mm.yyyy")
 
      ' Prüfen, ob ermittelter Wochentag berücksichtigt
      ' werden soll
      If InStr(WTage, Left$(ergebnis, 2)) > 0 Then
        strTage = ergebnis
      End If
    End If
  End If
 
  Datumschleife = strTage
End Function

Beispiel
Das erste Beispiel ermittelt alle Tage zwischen den festgelegten Datumswerten und gibt diese in einer MultiLine-Textbox aus:

Dim Datum1 As String
Dim Datum2 As String
 
Datum1 = "13.08.2001"
Datum2 = "19.08.2001"
Text1.Text = Datumschleife(Datum1, Datum2)
 
' Ergebnis:
' Mo, 13.08.2001;Di, 14.08.2001;Mi, 15.08.2001;
' Do, 16.08.2001;Fr, 17.08.2001;Sa, 18.08.2001;
' So, 19.08.2001

Das zweite Beispiel ermittelt alle Arbeitstage zwischen den festgelegten Datumswerten und gibt die Anzahl der "Urlaubstage" in einer MsgBox aus.

Dim Datum1 As String
Dim Datum2 As String
Dim strUrlaubstage As String
Dim strTemp() As String
 
Datum1 = "13.08.2001"
Datum2 = "19.08.2001"
strUrlaubstage = Datumschleife(Datum1, Datum2, _
  "Mo,Di,Mi,Do,Fr")
 
' Split-Befehl erst ab VB6
strTemp = Split(strUrlaubstage)
 
MsgBox "Anzahl Urlaubstage: " & UBound(strTemp)