Hafta Numarasından Tarih Hesaplama (ISO 8601)

Option Explicit
Sub Main()
    MsgBox "Friday of 2010 week 25 is " & DateofWeek(2010, 25, 5)
End Sub
Function DateofWeek(Year1, WeekNumber, DayofWeek1)
    Dim keyDate, keyWeekNo, weekDayofkeyWeek
    keyDate = DateSerial(Year1, 1, 15)
    keyWeekNo = WeekNoOfDate(Year1, 1, 15)
    weekDayofkeyWeek = GetWeekDay(Year1, 1, 15)
    DateofWeek = DateAdd("ww", WeekNumber - keyWeekNo, keyDate)
    DateofWeek = DateAdd("d", DayofWeek1 - weekDayofkeyWeek, DateofWeek)
End Function
Function WeekNoOfDate(Year1, Month1, Date1)
    Dim Weekday, Jan1Weekday, DOYNumber, WeekNumber, YearNumber
    Weekday = GetWeekDay(Year1, Month1, Date1)
    Jan1Weekday = January1WeekDay(Year1)
    DOYNumber = GetDayOfYearNumber(Year1, Month1, Date1)
    If DOYNumber <= (8 - Jan1Weekday) And Jan1Weekday > 4 Then
        YearNumber = Year1 - 1
        If Jan1Weekday = 5 Or (Jan1Weekday = 6 And IsLeapYear(Year1 - 1)) Then
            WeekNumber = 53
        Else
            WeekNumber = 52
        End If
    Else
        Dim I
        If IsLeapYear(Year1) Then
            I = 366
        Else
            I = 365
        End If
        If (I - DOYNumber) < (4 - Weekday) Then
            YearNumber = Year1 + 1
            WeekNumber = 1
        Else
            YearNumber = Year1
        End If
    End If
    Dim J
    If YearNumber = Year1 Then
        J = DOYNumber + (7 - Weekday) + (Jan1Weekday - 1)
        WeekNumber = Fix(J / 7)
        If Jan1Weekday > 4 Then WeekNumber = WeekNumber - 1
    End If
    WeekNoOfDate = WeekNumber
End Function
Function IsLeapYear(Year1)
    If (Year1 Mod 4 = 0 And Year1 Mod 100 <> 0) Or Year1 Mod 400 = 0 Then
        IsLeapYear = True
    Else
        IsLeapYear = False
    End If
End Function
Function GetDayOfYearNumber(Year1, Month1, Date1)
    If Month1 < 1 Or Month1 > 12 Then
        GetDayOfYearNumber = 0
        Exit Function
    End If
    Dim MonthDayArray
    MonthDayArray = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334)
    GetDayOfYearNumber = Date1 + MonthDayArray(Month1 - 1)
    If IsLeapYear(Year1) And Month1 > 2 Then
        GetDayOfYearNumber = GetDayOfYearNumber + 1
    End If
End Function
Function January1WeekDay(Year1)
    Dim YY, C, G
    YY = (Year1 - 1) Mod 100
    C = (Year1 - 1) - YY
    G = YY + Fix(YY / 4)
    January1WeekDay = 1 + ((((Fix(C / 100) Mod 4) * 5) + G) Mod 7)
End Function
Function GetWeekDay(Year1, Month1, Date1)
    Dim H
    H = GetDayOfYearNumber(Year1, Month1, Date1) + (January1WeekDay(Year1) - 1)
    GetWeekDay = 1 + ((H - 1) Mod 7)
End Function