Kalenderwochen mit VBA (Access, Excel) Bestimmen

09. April 2008 von Werner Mager · Gelesen: 1862 · heute: 1

Um Kalenderwochen zu bestimmen, muss man ein paar Klimmzüge machen, da die KW1 nicht immer die erste Woche eines Jahres ist.  Je nach dem, was der 4.1. für ein Wochentag ist, liegt die KW1 evtl. schon im Dezember des Vorjahres.  Mit den folgenden Funktionen lassen sich Kalenderwochen komfortabel ermitteln.

'--------------------------------------------------------
' Liefert das Datum des ersten Tages der übergebenen Kalenderwoche
'  kw - die Nummer der Kalenderwoche
'  yr - das Jahr in der die Woche liegt
Function getDateToKw(kw, yr)
   ' Finde Montag zu 4.1.
  fourthday = CDate("04.01." & yr)
  wd = Weekday(fourthday, vbMonday)
  fourthday = fourthday - wd + 1
  getDateToKw = fourthday + (7 * (kw - 1))
End Function
'--------------------------------------------------------
' Liefert die Kalenderwoche zu einem Monat
'  mth - der Monat
'  yr - das Jahr in der die Woche liegt
Function getKwToMonth(mth, yr)
  For i = 1 To 53
    d = getDateToKw(i, yr)
    If Month(d) = CInt(mth) And year(d) = CInt(yr) Then
      getKwToMonth = IIf(getKwToMonth = "", i, getKwToMonth & ";" & i)
    End If
  Next
End Function
'--------------------------------------------------------
' Liefert zu einem Datum die zugehörige Kalenderwoche
'  d - das Datum
Function getKwToDate(d)
  ' Finde Montag zu 4.1.
  fourthday = CDate("04.01." & year(d))
  wd = Weekday(fourthday, vbMonday)
  fourthday = CDate(fourthday - wd + 1)
  getKwToDate = CInt((CDate(d) - CDate(fourthday)) / 7) + 1
 End Function

 

Hinterlasse eine Antwort