VBA Tipp: Datum aus Kalenderwoche

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Zu Jahreszahl, Kalenderwochennummer nach ISO 8601 und Wochentagsnummer das entsprechende Datum ermitteln.

Lösung

Public Function ISO8601ToDate(ByVal aYear As Integer, _
                              ByVal aWeekNum As Integer, _
                              Optional ByVal aDayNum As Integer = 1) As Date
 
   'aYear:    Jahr, in dem die Kalenderwoche liegt
   'aWeekNum: Kalenderwoche
   'aDayNum:  Optionale Wochentagsnummer (1..7 => Mo..So)
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Const FUNC_NAME    As String = "ISO8601ToDate"
 
   Dim TempDate       As Date
   Dim Offset         As Long
   Dim YearHas53Weeks As Boolean
 
   If aYear < 100 Or aYear > 9999 Then
      Err.Raise 5, FUNC_NAME, "Jahr außerhalb der " & _
      "Spezifikation (100-9999)."
   End If
 
   TempDate = DateSerial(aYear, 1, 1)
   YearHas53Weeks = Weekday(TempDate) = vbThursday Or _
                    Weekday(DateSerial(aYear, 12, 31)) = vbThursday
 
   If aWeekNum < 1 Or aWeekNum > 52 + Abs(YearHas53Weeks) Then
      Err.Raise 5, FUNC_NAME, "Wochennummer außerhalb der " & _
      "Spezifikation (1-" & CStr(52 + Abs(YearHas53Weeks)) & ")."
   ElseIf aDayNum < 1 Or aDayNum > 7 Then
      Err.Raise 5, FUNC_NAME, "Wochentagsnummer außerhalb der " & _
                              "Spezifikation (1-7)."
   Else
      TempDate = TempDate + aWeekNum * 7
      Offset = -Weekday(TempDate, vbFriday) + 1
      ISO8601ToDate = TempDate - 4 + Offset + aDayNum - 1
   End If
End Function

Aufruf

im Direktfenster.

?ISO8601ToDate(2018, 52) 
24.12.2018 
 
?ISO8601ToDate(2018, 52, 2) 
25.12.2018 
 
?ISO8601ToDate(2019, 1, 1) 
31.12.2018 
 
?ISO8601ToDate(2019, 1, 2) 
01.01.2019