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
