|
Discussion:
|
ISOWeekNum is a function of Type Long that computes the ISO week number for any date. strISOWeekNum computes the same number but passes it back as a string in one of several user-selectable formats. The base code for both functions was written by John Green and is posted on Chip Pearson?s web site. Either function can be used in any VB/VBA application. The demo is Excel-based. For more on ISO week numbers and some of the strange results from the ISO standard J, read on ?
The following discussion is from Chip Pearson?s web site:
The International Organization for Standardisation (ISO), based in Switzerland, issued Standard 8601 -- Representation Of Dates And Times, in 1988. This provides some standardization for "week numbers". Of course, compliance with these standards is entirely voluntary, so your business may or may not use the ISO definitions.
Under the ISO standard, a week always begins on a Monday, and ends on a Sunday. The first week of a year is that week which contains the first Thursday of the year, or, equivalently, contains Jan-4.
While this provides some standardization, it can lead to unexpected results -- namely that the first few days of a year may not be in week 1 at all. Instead, they will be in week 52 of the preceding year! For example, the year 2000 began on Saturday. Under the ISO standard, weeks always begin on a Monday. In 2000, the first Thursday was Jan-6, so week 1 begins the preceding Monday, or Jan-3. Therefore, the first two days of 2000, Jan-1 and Jan-2, fall into week 52 of 1999.
An ISO week number may be between 1 and 53. Under the ISO standard, week 1 will always have at least 4 days. If 1-Jan falls on a Friday, Saturday, or Sunday, the first few days of the year are defined as being in the last (52nd or 53rd) week of the previous year.
Unlike absolute week numbers, not every year will have a week 53. For example, the year 2000 does not have a week 53. Week 52 begins on Monday, 25-Dec, and ends on Sunday, 31-Dec. But the year 2004 does have a week 53, from Monday, 27-Dec, through Friday, 31-Dec.
|
Option Explicit
Function ISOWeekNum(AnyDate As Date) As Long
Dim NextFirstMonday As Date
Dim PreviousFirstMonday As Date
Dim ThisYear As Integer
Dim ThisFirstMonday As Date
Dim YearNum As Integer
ThisYear = Year(AnyDate)
ThisFirstMonday = FirstMonday(ThisYear)
PreviousFirstMonday = FirstMonday(ThisYear - 1)
NextFirstMonday = FirstMonday(ThisYear + 1)
Select Case AnyDate
Case Is >= NextFirstMonday
ISOWeekNum = (AnyDate - NextFirstMonday) \ 7 + 1
YearNum = Year(AnyDate) + 1
Case Is < ThisFirstMonday
ISOWeekNum = (AnyDate - PreviousFirstMonday) \ 7 + 1
YearNum = Year(AnyDate) - 1
Case Else
ISOWeekNum = (AnyDate - ThisFirstMonday) \ 7 + 1
YearNum = Year(AnyDate)
End Select
End Function
Function strISOWeekNum(AnyDate As Date, _
Optional FormatOut As Integer = 0) As String
Dim ISOWkNum As Long
Dim NextFirstMonday As Date
Dim PreviousFirstMonday As Date
Dim ThisYear As Integer
Dim ThisFirstMonday As Date
Dim YearNum As Integer
ThisYear = Year(AnyDate)
ThisFirstMonday = FirstMonday(ThisYear)
PreviousFirstMonday = FirstMonday(ThisYear - 1)
NextFirstMonday = FirstMonday(ThisYear + 1)
Select Case AnyDate
Case Is >= NextFirstMonday
ISOWkNum = (AnyDate - NextFirstMonday) \ 7 + 1
YearNum = Year(AnyDate) + 1
Case Is < ThisFirstMonday
ISOWkNum = (AnyDate - PreviousFirstMonday) \ 7 + 1
YearNum = Year(AnyDate) - 1
Case Else
ISOWkNum = (AnyDate - ThisFirstMonday) \ 7 + 1
YearNum = Year(AnyDate)
End Select
Select Case FormatOut
Case Is = 0, 1
strISOWeekNum = Format(ISOWkNum, "00")
Case Is = 2
strISOWeekNum = Format(Right(YearNum, 2), "00") & _
Format(ISOWkNum, "00")
Case Is = 3
strISOWeekNum = "'" & Format(Right(YearNum, 2), "00") & _
Format(ISOWkNum, "00")
Case Is = 4
strISOWeekNum = Format(YearNum, "0000") & _
Format(ISOWkNum, "00")
End Select
End Function
Function FirstMonday(WhichYear As Integer) As Date
Dim NewYear As Date
Dim WeekDay As Integer
NewYear = DateSerial(WhichYear, 1, 1)
WeekDay = (NewYear - 2) Mod 7
If WeekDay < 4 Then
FirstMonday = NewYear - WeekDay
Else
FirstMonday = NewYear - WeekDay + 7
End If
End Function
Sub ISOWeekNum_Test()
Dim strTemp As String
Dim TargetDate As Date
Dim Title As String
Title = "ISOWeekNum"
GetDate:
On Error Resume Next
strTemp = InputBox("enter any date in standard date format", Title)
If strTemp = "" Then Exit Sub
TargetDate = strTemp
If Err <> 0 Then
MsgBox "data entered is not in the form of a valid date." & vbCrLf & _
"click on CANCEL button to exit procedure.", vbCritical, Title
GoTo GetDate:
End If
MsgBox "for entered date = " & Format(TargetDate, "dd-mmm-yyyy") & vbCrLf & vbCrLf & _
"return from ISOWeekNumber is " & ISOWeekNum(TargetDate) & vbCrLf & _
"return from strISOWeekNumber (FormatOut = 0) is " & strISOWeekNum(TargetDate) & vbCrLf & _
"return from strISOWeekNumber (FormatOut = 2) is " & strISOWeekNum(TargetDate, 2) & vbCrLf & _
"return from strISOWeekNumber (FormatOut = 3) is " & strISOWeekNum(TargetDate, 3) & vbCrLf & _
"return from strISOWeekNumber (FormatOut = 4) is " & strISOWeekNum(TargetDate, 4), _
vbInformation + vbOKOnly, Title
GoTo GetDate
End Sub
|