[Excel-VBA] x-te Tag im Jahr / x-te Montag im Jahr / der x-te Montag im Monat ...

Gepostet am: Mar 26, 2013 12:46:29 PM

Heute möchte ich mich mit mit den Zusammenhängen der Wochentagen und Tagen im Jahr beschäftigen. Ich persönlich benötige Sie zwar recht selten in Excel, sondern als Scripting Component im SQL-Server, die Fuktionsweise ist jedoch die selbe. Vorerst zur Frage - für was braucht man das. Gerade im BI-Themenbereich ist die Frage nach den Verkaufszahlen am 3. Novemberwochenende interessanter als an einem konkreten Datum.

x.te Tag im Jahr

Es geht also um Fragestellungen, wie beispielsweise - der wie vielte Tag der 26.03.2013 ist. 

X_Day_of_Year

Public Function X_Day_of_Year(myDate As Date) As Integer     X_Day_of_Year = DateDiff("d", DateSerial(Year(myDate), 1, 1), myDate) + 1End Function

Jetzt wäre natürlich die Rückrechnng auch noch interessant - mal abgesehen von Schaltjahren ist der 85. Tag des Jahres immer der 26.03.2013.

X_Day_of_Year_reverse

Public Function X_Day_of_Year_reverse(XDay As Integer, Jahr As Integer) As Date     X_Day_of_Year_reverse = DateSerial(Jahr, 1, 1 + XDay - 1)End Function

x.te Montag im Jahr

Es gibt Situationen bei denen man den 3. Dienstag in einem Jahr benötigt, dann kann man auf folgende Funktion zurückgreifen. (Alternative ohne VBA siehe hier)

X_CertainWeekDay_of_Year

Public Function X_CertainWeekDay_of_Year(X As Integer, Wochentag As String, Jahr As Integer) As DateDim currentDate As DateDim tmpString As StringDim myCounter As Integer myCounter = 0 currentDate = DateSerial(Jahr, 1, 1)For i = 0 To 365     tmpString = Choose(Weekday(currentDate), "Sonntag", "Montag", "Dienstag", _          "Mittwoch", "Donnerstag", "Freitag", "Samstag")     If tmpString = Wochentag Then         myCounter = myCounter + 1     End If     If X = myCounter Then         Exit For     End If     currentDate = DateSerial(Year(currentDate), Month(currentDate), Day(currentDate) + 1)Next X_CertainWeekDay_of_Year = currentDate End Function

Und nun möchte man naturlich auch wissen, welcher Tag der 3. Dienstag im Jahr 2013 ist

X_CertainWeekDay_of_Year_reverse

Public Function X_CertainWeekDay_of_Year_reverse(myDate As Date) As Integer     Dim i As Integer     Dim j As Integer     Dim currYear As Integer     currYear = Year(myDate)     Dim currWeekday As Integer     currWeekday = Weekday(myDate)     Dim counter As Integer     counter = 0     For j = 1 To 12         For i = 1 To 31             If (IsDate(i & "." & j & "." & currYear) = True) Then             If (myDate >= DateSerial(currYear, j, i)) Then                 If Weekday(DateSerial(currYear, j, i)) = currWeekday Then                     counter = counter + 1                 End If             End If             End If         Next     Next     X_CertainWeekDay_of_Year_reverse = counter End Function

der x.te Montag im Monat

Die selbe Vorgehensweise kann man natürlich auch auf das Monat anwenden. - zB. Der 2. Dienstag im August 2013

X_CertainWeekDay_of_Month

Public Function X_CertainWeekDay_of_Month(X As Integer, Wochentag As String, Monat As Integer, Jahr As Integer) As DateDim currentDate As DateDim tmpString As StringDim myCounter As Integer myCounter = 0 currentDate = DateSerial(Jahr, Monat, 1)For i = 0 To 31         tmpString = Choose(Weekday(currentDate), "Sonntag", "Montag", "Dienstag", _              "Mittwoch", "Donnerstag", "Freitag", "Samstag")         If tmpString = Wochentag Then             myCounter = myCounter + 1             Debug.Print currentDate & "---" & myCounter         End If         If X = myCounter Then             X_CertainWeekDay_of_Month = currentDate             Exit Function         End If         If Month(currentDate) > Monat Then             X_CertainWeekDay_of_Month = CVErr(xlErrNA)             Exit Function         End If         currentDate = DateSerial(Year(currentDate), Monat, Day(currentDate) + 1)NextEnd Function

Und die Umkehrfunktion:

X_CertainWeekDay_of_Month_reverse

Public Function X_CertainWeekDay_of_Month_reverse(myDate As Date) As Integer     Dim i As Integer     Dim currYear As Integer     currYear = Year(myDate)     Dim currWeekday As Integer     currWeekday = Weekday(myDate)     Dim counter As Integer     counter = 0         For i = 1 To 31             If (IsDate(i & "." & Month(myDate) & "." & currYear) = True) Then             If (myDate >= DateSerial(currYear, Month(myDate), i)) Then                 If Weekday(DateSerial(currYear, Month(myDate), i)) = currWeekday Then                     counter = counter + 1                 End If             End If             End If         Next     X_CertainWeekDay_of_Month_reverse = counter End Function