|
Haben Sie auch schon hin und wieder etwa den ersten Montag oder den dritten Sonntag in einem Monat gesucht? Keine der vielfältigen Datums-Funktion in Visual Basic kann eine solche Frage direkt beantworten. Das erste Vorkommen eines Wochentages in einem Monat lässt sich jedoch im Prinzip ganz einfach ermitteln. Entweder ist der 1. eines gegebenen Monats bereits der gesuchte Wochentag, oder sie zählen zum 1. des Monats so lange einen Tag hinzu, bis der jeweilige Tag dem gesuchten Wochentag entspricht.
Es gibt sogar eine Formel, die eine solche wenig elegante Zählschleife ersetzt:
Datum = DateAdd("d", _
(Wochentag - Weekday(MonatsErster) + 7) Mod 7, MonatsErster)
Das zweite, dritte, vierte oder auch fünfte Vorkommen können Sie nun ermitteln, indem Sie mittels der DateAdd-Funktion die entsprechende Anzahl Wochen hinzuzählen:
If Vorkommen > 1 Then
Datum = DateAdd("ww", Vorkommen - 1, Datum)
End If
Allerdings können Sie so auch den 10. Donnerstag eines Monats ermitteln - und den gibt es ja eigentlich nicht. Da sie allerdings nicht wissen können, ob es ein viertes oder fünftes Vorkommen gibt, reduzieren Sie die Eingabe auf 5 Vorkommen und prüfen anschließend, ob der Monat noch übereinstimmt. Ist das nicht der Fall, ziehen Sie einfach wieder eine Woche ab.
In der folgenden Funktion WeekdayOfMonth finden Sie eine vollständige Umsetzung. Sie übergeben ihr den gewünschten Wochentag als einen Wert aus den VBDayOfWeek-Konstanten, optional den gewünschten Monat und das gewünschte Jahr (gegebenenfalls werden der aktuelle Monat und das aktuelle Jahr verwendet) und die das gewünschte Vorkommen (Voreinstellung ist 1). Außerdem können Sie im letzten optionalen Parameter (Reaction) noch festlegen, wie eine überzogene Vorkommen-Anforderung behandelt werden soll: Entweder wird das tatsächlich letzte Vorkommen zurückgegeben ("GetLast", wie oben beschrieben), oder es wird ignoriert und es bleibt bei der hinzugezählten Anzahl von Wochen, oder es wird ein Laufzeitfehler (Nr. 5) ausgelöst.
Public Enum womReactionConstants
GetLast
Ignore
RaiseError
End Enum
Public Function WeekdayOfMonth(ByVal Weekday As VbDayOfWeek, _
Optional ByVal Month As Integer, Optional ByVal Year As Integer, _
Optional ByVal Occurance As Integer = 1, _
Optional ByVal Reaction As womReactionConstants) As Date
Dim nDay As Date
If Month = 0 Then
Month = VBA.Month(Now)
End If
If Year = 0 Then
Year = VBA.Year(Now)
End If
nDay = DateSerial(Year, Month, 1)
If VBA.Weekday(nDay) <> Weekday Then
nDay = _
DateAdd("d", (Weekday - VBA.Weekday(nDay) + 7) Mod 7, nDay)
End If
Select Case Occurance
Case Is < 0
Occurance = 5
Case 1 To 5
Case Is > 5
Select Case Reaction
Case GetLast
Occurance = 5
Case RaiseError
Err.Raise 5
End Select
End Select
nDay = DateAdd("ww", Occurance - 1, nDay)
If VBA.Month(nDay) <> Month Then
Select Case Reaction
Case Ignore
Case GetLast
nDay = DateAdd("ww", -1, nDay)
End Select
End If
WeekdayOfMonth = nDay
End Function
Mittels dieser Funktion können Sie auch die Aufgabe lösen, die Datumswerte für periodische Ereignisse nach dem Muster "an jedem zweiten Samstag im Monat" zu ermitteln. Die entsprechende Schleife durch alle zwölf Monate erledigt die Funktion WeekdayOfMonthInYear. Sie gibt ein Array (mit den Indices 1 bis 12) zurück, das die gesuchten Datumswerte enthält.
Public Function WeekdayOfMonthInYear(ByVal Weekday As VbDayOfWeek, _
Optional ByVal Year As Integer, _
Optional ByVal Occurance As Integer = 1, _
Optional ByVal Reaction As womReactionConstants) As Date()
Dim nDates() As Date
Dim i As Integer
If Year = 0 Then
Year = VBA.Year(Now)
End If
ReDim nDates(1 To 12)
For i = 1 To 12
nDates(i) = _
WeekdayOfMonth(Weekday, i, Year, Occurance, Reaction)
Next 'i
WeekdayOfMonthInYear = nDates
End Function
Schließlich liefert Ihnen die Variante WeekDayOfMonthAll alle Vorkommen eines Wochentages in einem Monat als Array (erster Index = 1):
Public Function WeekdayOfMonthAll(ByVal Weekday As VbDayOfWeek, _
Optional ByVal Month As Integer, _
Optional ByVal Year As Integer) As Date()
Dim nDates() As Date
Dim i As Integer
ReDim nDates(1 To 5)
If Month = 0 Then
Month = VBA.Month(Now)
End If
If Year = 0 Then
Year = VBA.Year(Now)
End If
nDates(1) = DateSerial(Year, Month, 1)
If VBA.Weekday(nDates(1)) <> Weekday Then
nDates(1) = DateAdd("d", _
(Weekday - VBA.Weekday(nDates(1)) + 7) Mod 7, nDates(1))
End If
For i = 2 To 5
nDates(i) = DateAdd("ww", 1, nDates(i - 1))
If VBA.Month(nDates(i)) <> Month Then
ReDim Preserve nDates(1 To i - 1)
Exit For
End If
Next 'i
WeekdayOfMonthAll = nDates
End Function
|