• Bug funkcji WOY (MyDate As Date) As Integer ' Week Of Year

W poprzednim poście Data tygodniowa ISO 8601 poruszyłem temat „Funkcja konwertująca datę do formatu daty tygodniowej, zgodnie z normą ISO 8601”. Napisana tam funkcja funDataTygodniowaISO8601 (...) nie działała prawidłowo. Użyte funkcje Format (...) i DatePart (...) nie zawsze zwracały prawidłowy wynik.
Na stronie http://support.microsoft.com/pl-pl/kb/200299  znalazłem artykuł, który opisuje błąd biblioteki Oleaut32.dll:
Przy ustalaniu numeru tygodnia zgodnie z normą ISO 8601, za pomocą funkcji Format (...) lub DatePart (...) z biblioteki Oleaut32.dll w postaci:

'• AnyDate - argument typu Variant (Date), która ma zostać wyliczony
'• "WW" - (tydzień) przedział czasu, który ma zostać zwrócony
'• vbMonday - tydzień zaczyna się od Poniedziałku,
'• vbFirstFourDays - pierwszy tydzień roku musi zawierać Czwartek
 
Format (AnyDate "WW", vbMonday, vbFirstFourDays)
DatePart ("WW", AnyDate, vbMonday, vbFirstFourDays)
 

funkcja Format (...) oraz funkcja DatePart (...), dla ostatniego poniedziałku w niektórych latach, zwracają nieprawidłowy numer tygodnia (53 tydzień), zamiast 1-szy tydzień.

Przykładowo:
29-12-2003;   poniedziałek;  tydzień: 53;  zamiast;  1
31-12-2007;   poniedziałek;  tydzień: 53;  zamiast;  1
30-12-2019;   poniedziałek;  tydzień: 53;  zamiast;  1
29-12-2031;   poniedziałek;  tydzień: 53;  zamiast;  1
31-12-2035;   poniedziałek;  tydzień: 53;  zamiast;  1
30-12-2047;   poniedziałek;  tydzień: 53;  zamiast;  1

W Visual Basic for Applications, wszystkie funkcje daty, z wyjątkiem funkcji DateSerial (...), pochodzą z biblioteki Oleaut32.dll. Ponieważ zarówno funkcja Format (...) jak i funkcja DatePart (...) mogą zwrócić liczbę tygodni kalendarzowych dla danej daty, obie są dotknięte tym błędem. Aby uniknąć tego problemu:

Microsoft proponuje następujące obejście problemu:

Jeżeli funkcja Format (...) lub DatePart (...) zwróci numer tygodnia równy 53, należy uruchomić instrukcję sprawdzającą numer następnego tygodnia dla argumentu MyDate + 7. Jeżeli zwracany następny tydzień będzie 2-gim tygodniem roku, to zwracana wartość przez funkcję WOY musi być równa 1.

'• MyDate - argument typu Variant (Date), która ma zostać wyliczony
'• "ww" - (tydzień) przedział czasu, który ma zostać zwrócony
'• vbMonday - tydzień zaczyna się od Poniedziałku,
'• vbFirstFourDays - pierwszy tydzień roku musi zawierać Czwartek
 
 Function WOY(MyDate As Date) As Integer    ' Week Of Year
  WOY = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
  If WOY > 52 Then
    If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then WOY = 1
  End If
End Function
 

I wszystko by było dobrze, ale funkcja WOY (MyDate As Date) dla poniższych dat zwraca numer tygodnia 53, a powinna zwrócić numer 52.

WOY(CDate("02-01-2101")) = 53
WOY(CDate("02-01-2501")) = 53
WOY(CDate("02-01-2901")) = 53
WOY(CDate("02-01-3301")) = 53
WOY(CDate("02-01-3701")) = 53
WOY(CDate("02-01-4101")) = 53
WOY(CDate("02-01-4501")) = 53

Innymi słowy, Microsoft powinien zrobić poprawkę do poprawki. Mniej więcej, coś w tym stylu:

'• MyDate - argument typu Variant (Date), która ma zostać wyliczony
'• "ww" - (tydzień) przedział czasu, który ma zostać zwrócony
'• vbMonday - tydzień zaczyna się od Poniedziałku,
'• vbFirstFourDays - pierwszy tydzień roku musi zawierać Czwartek
 
Function WOYC(MyDate As Date) As Integer    ' Week Of Year Corrected

   WOYC = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
   If WOYC > 52 Then
      If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) = 2 Then
         WOYC = 1
      ElseIf Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) = 1 And _
            WeekDay(MyDate, vbMonday) = 7 And _
            Day(MyDate) = 2 And _
            Format(MyDate - 7, "ww", vbMonday, vbFirstFourDays) = 51 Then
         WOYC = 52
      End If
   End If
End Function
 

Nie ma tego złego, co by na dobre nie wyszło. Pod sam koniec artykułu Microsoft zamieścił funkcję WeekNumber (InDate As Date), która prawidłowo wylicza numery dni tygodni i nie korzysta z niedopracowanej (zwracającej błędne dane) funkcji WOY(MyDate As Date).
Poniżej przedstawiam listing funkcji WeekNumber (...) ze strony http://support.microsoft.com/pl-pl/kb/200299

 
Function WeekNumber(InDate As Date) As Integer
  Dim DayNo As Integer
  Dim StartDays As Integer
  Dim StopDays As Integer
  Dim StartDay As Integer
  Dim StopDay As Integer
  Dim VNumber As Integer
  Dim ThurFlag As Boolean

  DayNo = Days(InDate)
  StartDay = WeekDay(DateSerial(Year(InDate), 1, 1)) - 1
  StopDay = WeekDay(DateSerial(Year(InDate), 12, 31)) - 1
  ' Number of days belonging to first calendar week
  StartDays = 7 - (StartDay - 1)
  ' Number of days belonging to last calendar week
  StopDays = 7 - (StopDay - 1)
  ' Test to see if the year will have 53 weeks or not
  If StartDay = 4 Or StopDay = 4 Then ThurFlag = True Else ThurFlag = False
  VNumber = (DayNo - StartDays - 4) / 7
  ' If first week has 4 or more days, it will be calendar week 1
  ' If first week has less than 4 days, it will belong to last year's
  ' last calendar week
  If StartDays >= 4 Then
     WeekNumber = Fix(VNumber) + 2
  Else
     WeekNumber = Fix(VNumber) + 1
  End If
  ' Handle years whose last days will belong to coming year's first
  ' calendar week
  If WeekNumber > 52 And ThurFlag = False Then WeekNumber = 1
  ' Handle years whose first days will belong to the last year's
  ' last calendar week
  If WeekNumber = 0 Then
     WeekNumber = WeekNumber(DateSerial(Year(InDate) - 1, 12, 31))
  End If
End Function

Function Days(DayNo As Date) As Integer
  Days = DayNo - DateSerial(Year(DayNo), 1, 0)
End Function
 

Przy wykorzystaniu, do wyliczenia numeru tygodnia  funkcji WeekNumber (InDate As Date) ze strony Microsoftu, funkcja WeekDateISO (...) konwertująca datę do formatu daty tygodniowej, zgodnie z normą ISO 8601, będzie miała postać:

' Pobiera:
'  • datDate - data do przekonwertowania na format ISO
'  • strDelimDate - separator daty, domyślnie [-] myślnik
'  • strPrefixWeek - prefix przed dwucyfrowym numerem tygodnia, domyślnie [W]
' Zwraca:
'  Przy powodzeniu zwraca sformatowaną datę tygodniową (ISO-8601 )
'  Poszczególne elementy daty rozdzielone opcjonalnym separatorem daty
'  przekazanym w argumencie strDelimDate, dwucyfrowy numer tygodnia poprzedzony
'  jest opcjonalnym prefiksem przekazanym w argumentcie strPrefixWeek.
'  Przy niepowodzeniu zwraca ciąg zerowej długości.
 
Public Function WeekDateISO(datDate As Date, _
                  Optional strDelimDate As String = "-", _
                  Optional strPrefixWeek As String = "W") As String

Dim intYear As Integer
Dim intWeek As Integer
Dim intDay As Integer

   ' pobierz rok
   intYear = Year(datDate)
   
   ' pobierz numer tygodnia, korzystając z funkcji WeekNumber Microsoftu:
   intWeek = WeekNumber(datDate)

   If Month(datDate) = 12 And intWeek = 1 Then
      intYear = intYear + 1
   ElseIf (Month(datDate) = 1 And (intWeek = 52 Or intWeek = 53)) Then
      intYear = intYear - 1
   End If

   ' pobierz numer dnia w tygodniu (licząc od poniedziałku)
   intDay = WeekDay(datDate, vbMonday)
   
   WeekDateISO = CStr(intYear) & strDelimDate & _
               strPrefixWeek & Format$(intWeek, "00") & _
               strDelimDate & CStr(intDay)
  
End Function

' poniżej przykład jak wywołać funkcję: WeekDateISO(...)
Private Sub cmdTest_Click()
Dim strDataISO As String
Dim dtData As Date

   dtData = CDate("3 stycznia 2010")
   'prawidłowo powinniśmy przekazać datę po "amerykańsku" #1/3/2010#
   strDataISO = WeekDateISO(dtData, "-")
   MsgBox "3 stycznia 2010" & " => " & strDataISO


   dtData = CDate("31 grudnia 2007")
   strDataISO = WeekDateISO(dtData, "-")
   MsgBox "31 grudnia 2007" & " => " & strDataISO

End Sub