Thema: Jahreskalender mit KW nach DIN1355 anlegen

StandardModule: Modul1

Sub DatumUndKW()
   Dim iCount As Integer, iCounter As Integer
   If Month(DateSerial(Year(Date), 2, 29)) = 2 Then
      iCount = 366
   Else
      iCount = 365
   End If
   For iCounter = 1 To iCount
      Cells(iCounter, 1) = DateSerial(Year(Date), 1, iCounter)
      Cells(iCounter, 2) = DINWeek(Cells(iCounter, 1))
   Next iCounter
End Sub

Private Function DINWeek(dat As Date) As Integer
   Dim dbl As Double
   dbl = DateSerial(Year(dat + (8 - Weekday(dat)) Mod 7 - 3), 1, 1)
   DINWeek = (dat - dbl - 3 + (Weekday(dbl) + 1) Mod 7) \ 7 + 1
End Function

Beiträge aus dem Excel-Forum zu den Themen DatumZeit und Kalender