Kalenderwoche ISO 8601: Range

[TMC]

Hi,

ich weiss es gibt diverse Scripts im www zur Kalenderwoche.

Nun suche ich eine Function an die ich die Kalenderwoche übergebe und als Rückgabewert dann die Datums-Range erhalte.

Beispiel:
Ich übergene KW 27-2004
Ich erhalte: 28.06.2004 - 04.07.2004

Das ganze sollte ISO 8601 - konform sein.

Hab ich auch schon öfter im www gesehen, nur aktuell finde ich es nicht....

[TMC]

Habe es hier jetzt anders gelöst, da mir das Ausgangsdatum bekannt ist.

Dazu habe ich die im Web bekannte CalendarWeek - Function entsprechend angepasst (siehe Anhang - einfach in neue ScriptLib importieren).


Trotzdem bin ich noch an einer Lösung interessiert, wie man aus einer gegebenen Kalenderwoche+Jahr den Montag und Sonntag als Datum bekommt.

[koehlerbv]

Nur so als eine Anregung für den Algorithmus:
Die Meis / TMC-Routinen berechnen ja mehr oder weniger schon den 1. Tag der jeweiligen KW 1. Von diesem ausgehend ist
Day1 + (KW - 1) * 7
der erste Tag der gewünschten Woche KW, nochmal 6 addiert ergibt den Sonntag.

HTH,
Bernhard

[TMC]

Danke Bernhard, ist mir auch aufgefallen (nachdem ich das umsetzte) :-)

Ist auch noch ein Bug drin (Fulltrim...); außerdem ist die Nutzung der NotesDateTime-Klasse zur Überprüfung ob Datum imho unnötig.

Habe mittlerweile eine Excel-VBA-Lösung im Web gesehen für das eigentliche Problem. Werde ich noch umsetzen und poste ich dann wieder hier.

[TMC]

Schon fast vergessen noch zu posten. Ich glaub ich hab's - siehe Code unten.
Zurückgegeben wird ein Datum, welches der Montag der Kalenderwoche ist.

Ein mulmiges Gefühl habe ich noch beim Jahreswechsel (KW 52/53/01). Nach den ersten Tests klappt es aber.

Quelle war übrigens eine Excel-Formel:

Kalenderwoche eingeben und Zeitraum erhalten nach DIN
In A1 ist die Kalenderwoche.
In A2 die vierstellige Jahreszahl
In A3 (Hilfszelle) steht:
=DATUM(A2;1;1)+(A1-WENN(WOCHENTAG(DATUM(A2;1;1);2)>4;0;1))*7
Der Montag der KW steht in A5:
=A3-WOCHENTAG(A3;2)+1

Code

Public Function GetWeekMonday(iInputWeek As Integer, iInputYear As Integer) As Variant
   
   On Error Goto ERRORHANDLER
   
   Dim iDaysInYear As Integer
   Dim iWeekday As Integer
   Dim iWeekday2 As Integer
   'Variants of DataType 7 (Date/Time) --->
   Dim vFirstJan As Variant   
   Dim vDateRef As Variant
   Dim vDateMonday As Variant
   '<----
   
   '--> Errorhandling
   If iInputWeek > 53 Then
      Error 1001, "Wrong calendar week '"   & Cstr(iInputWeek) & "'. Must not be > 53"
   End If
   If iInputWeek < 0 Then
      Error 1002, "Wrong calendar week '" & Cstr(iInputWeek) & "'. Must not be < 0"
   End If
   If Len( Cstr(iInputYear) ) <> 4 Then
      Error 1003, "Wrong year '" & Cstr(iInputYear) & "'. It must have 4 digits"
   End If
   '<---
   
   'The first day of the year
   vFirstJan = Datevalue("01/01/" + Cstr(iInputYear))
   
   'Days in the year
   iWeekday = CalculateIsoWeekday( vFirstJan )
   If iWeekday > 3 Then
      iDaysInYear = iInputWeek * 7
   Else
      iDaysInYear = (iInputWeek-1) * 7
   End If
   
   'We create a reference date in the current year
   vDateRef = vFirstJan + iDaysInYear
   'We need the monday ---->
   iWeekday2 = CalculateIsoWeekday( vDateRef ) + 1
   If iWeekday2 = 1 Then
      vDateMonday = vDateRef
   Else
      vDateMonday = vDateRef - iWeekday2 + 1
   End If
   '<-----
   
   GetWeekMonday = vDateMonday
   
   
EXITSCRIPT:
   Exit Function
   
ERRORHANDLER:
   Call ErrorMessage ("Function 'GetWeekMonday'")
   Resume EXITSCRIPT
   
   
End Function

Benutzt wird bei der Function noch folgende Function:

Code

Function CalculateIsoWeekday( tmpdate As Variant ) As Integer
   
%REM
Function is used by GetCalendarWeek.
This function converts the weekday-numbers from the
standard function to an offset acc. to the ISO version
monday -> 0, ... , sunday -> 6
%END REM
   
   On Error Goto ERRORHANDLER
   
   Dim n As Integer
   
   n = Weekday( tmpdate )
   
   If n = 1 Then ' sunday to end of week
      n = n + 7
   End If
   
   CalculateIsoWeekday = n - 2
   
EXITSCRIPT:
   Exit Function
   
ERRORHANDLER:
   Call ErrorMessage ("Function 'GetDateRange'")
   Resume EXITSCRIPT
   
End Function