VBA Tipp: Kalenderwoche aus Datum

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Bestimmt die Kalenderwoche nach ISO 8601 zu einem gegebenen Datum.

Wiki hinweis.png Hinweis: Die Funktionen DatePart und Format weisen Fehler beim Berechnen der Kalenderwoche nach ISO 8601 bei einigen Montagen in Kalenderwoche 53 und Kalenderwoche 1 auf.


Public Function ISO8601WeekNumber(ByVal aDate As Date) As Integer
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim weekNum As Integer
 
   aDate = Fix(aDate)
   weekNum = DatePart("ww", aDate, vbUseSystemDayOfWeek, vbUseSystem)
   If weekNum = 53 Then
      If Weekday(aDate, vbUseSystemDayOfWeek) = Weekday(aDate, vbMonday) Then
         Select Case Weekday(aDate, vbMonday)
         Case 1: If ISO8601WeekNumber(aDate + 1) < weekNum Then weekNum = 1
         'vermutlich unnötig
         'Case 7: If ISO8601WeekNumber(aDate - 1) < weekNum Then weekNum = 52
         End Select
      End If
   End If
   ISO8601WeekNumber = weekNum
End Function

Aufruf

im Direktfenster.

Public Sub TestISO8601WeekNumber()
   Dim knownCriticalDates, dt
 
   'seltsam, welche Zeilenfortsetziungen hier VBA7 unter Access 2010 macht!!!
   knownCriticalDates = Array(#12/29/1851#, #12/31/1855#, #12/30/1867#, #12/29/1879#, # _
                              12/29/2003#, #12/31/2007#, #12/30/2019#, #12/29/2031#, # _
                              12/31/1883#, #12/30/1895#, #12/31/2035#, #12/30/2047#, # _
                              12/29/2059#, #12/31/2063#, #12/30/2075#, #12/29/2087#, # _
                              12/31/2091#)
   For Each dt In knownCriticalDates
      Debug.Print ISO8601WeekNumber(dt);  'ergibt: 1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1  1
   Next
End Sub

Weblinks