Last active
January 25, 2017 13:46
-
-
Save pudelosha/c36351c7169e0a67bfe461911c522dcb to your computer and use it in GitHub Desktop.
VBA ISO week handling
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Option Explicit | |
| Function FirstWeekOfYear(lngYear As Long) As Date | |
| Dim datDate As Date | |
| Dim bytDayNumber As Byte | |
| 'Get the date that represents the fourth day of January for the given year. | |
| datDate = DateSerial(lngYear, 1, 4) | |
| 'A week starts with Monday (day 1) and ends with Sunday (day 7). | |
| bytDayNumber = WorksheetFunction.Weekday(datDate, 2) | |
| 'Since the week starts with Monday, figure out what day that Monday falls on. | |
| FirstWeekOfYear = DateAdd("d", 1 - bytDayNumber, datDate) | |
| End Function | |
| Function GetIsoDate(datDate As Date) As Long | |
| Dim lngYear As Long | |
| Dim datFirstWeek As Date | |
| lngYear = Year(datDate) | |
| 'If we are near the end of the year, then we need to calculate what next year's first week should be. | |
| If datDate > DateSerial(lngYear, 12, 29) Then | |
| If datDate = DateSerial(9999, 12, 31) Then | |
| datFirstWeek = FirstWeekOfYear(lngYear) | |
| Else | |
| datFirstWeek = FirstWeekOfYear(lngYear + 1) | |
| End If | |
| 'If the current date is less than next years first week, then we are still in the last month of the current year, otherwise change to next year. | |
| If datDate < datFirstWeek Then | |
| datFirstWeek = FirstWeekOfYear(lngYear) | |
| Else | |
| lngYear = lngYear + 1 | |
| End If | |
| Else | |
| 'We aren't near the end of the year, so make sure we're not near the beginning. | |
| datFirstWeek = FirstWeekOfYear(lngYear) | |
| 'If the current date is less than the current years first week, then we are in the last month of the previous year. | |
| If datDate < datFirstWeek Then | |
| If datDate = DateSerial(1, 1, 1) Then | |
| datFirstWeek = FirstWeekOfYear(lngYear) | |
| Else | |
| lngYear = lngYear - 1 | |
| datFirstWeek = FirstWeekOfYear(lngYear) | |
| End If | |
| End If | |
| End If | |
| 'Return the ISO date as a numeric value, so it makes it easier to get the year and the week. | |
| GetIsoDate = (lngYear * 100) + (WorksheetFunction.RoundDown((datDate - datFirstWeek) / 7, 0) + 1) | |
| End Function | |
| Function IsoDateToWeek(lngIsoWeek As Long) As String | |
| If Len(CStr(lngIsoWeek)) <> 6 Then | |
| MsgBox "Provided date date value must have 6 digits!" | |
| Exit Function | |
| Else | |
| IsoDateToWeek = Mid(lngIsoWeek, 3, 2) & "_W" & Right(lngIsoWeek, 2) | |
| End If | |
| End Function | |
| Function GetLastIsoWeek(intYear As Integer) As String | |
| Dim datLastDay As Date | |
| Dim strIsoLastWeek As String | |
| Dim i As Integer | |
| datLastDay = DateSerial(intYear, 12, 31) | |
| strIsoLastWeek = GetIsoDate(datLastDay) | |
| If CStr(Left(strIsoLastWeek, 4)) = CStr(intYear) Then | |
| GetLastIsoWeek = strIsoLastWeek | |
| Else | |
| For i = 30 To 20 Step -1 | |
| datLastDay = DateSerial(intYear, 12, i) | |
| strIsoLastWeek = GetIsoDate(datLastDay) | |
| If CStr(Left(strIsoLastWeek, 4)) = CStr(intYear) Then | |
| GetLastIsoWeek = strIsoLastWeek | |
| Exit Function | |
| End If | |
| Next i | |
| End If | |
| End Function | |
| Sub Test_2() | |
| Debug.Print GetLastIsoWeek(2017) | |
| End Sub | |
| Sub Test_1() | |
| Debug.Print GetIsoDate(DateSerial(2017, 1, 20)) | |
| End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment