Get a WeekNumber's end date using excel macro

问题

I have 3 columns: Year, Weeknum, WeekRange. i'd like the WeekRange column to display the Start and End Dates based on the Year and WeekNum values. I found a code that calculates the Start Date and it works fine but i cant find anything that shows how to get the End Date.

here's the code i found(assuming the WeekNumber is 4 and the Year is 2020)

Function WeekStartDate(Optional intMonth As Integer = 1, _
Optional intDay As Integer = 1)

Dim FromDate As Date, lngAdd As Long
Dim WKDay, WDays As Integer

Dim intWeek, intYear As Integer
intWeek = 4
WDays = 0
intYear = 2020

'Calculating the date
FromDate = DateSerial(intYear, intMonth, intDay)


'Getting the week day # of the specified date considering monday as first day
WKDay = WeekDay(FromDate, vbMonday)

'If value of week day is greater than 4 then subtracting 1 from the week number
If WKDay > 4 Then
    WDays = (7 * intWeek) - WKDay + 1
Else
    WDays = (7 * (intWeek - 1)) - WKDay + 1
End If

'Return the first day of the week`enter code here`
WeekStartDate = FromDate + WDays

Appreciate any help i can get.

回答1:

Here is a formula solution (no VBA required).

Assuming:

Cell A2 has the year.

Cell B2 has the week number.

Use this formula to get the WeekRange...

=TEXT(DATE(A2,1,1)+7*B2 - WEEKDAY(DATE(A2,1,1)+7*B2,1) + 1,"mm/dd/yy") & " - " & TEXT(DATE(A2,1,1)+7*B2 - WEEKDAY(DATE(A2,1,1)+7*B2,1) + 7,"mm/dd/yy")

The above also assumes you prefer the start of the week to be Sunday. If you would rather the start of the week be Monday then use this instead...

=TEXT(DATE(A2,1,1)+7*B2 - WEEKDAY(DATE(A2,1,1)+7*B2,2) + 1,"mm/dd/yy") & " - " & TEXT(DATE(A2,1,1)+7*B2 - WEEKDAY(DATE(A2,1,1)+7*B2,2) + 7,"mm/dd/yy")

Finally, you can change the format of the date by adjusting the occurrences of "mm/dd/yy" to suit your need.

回答2:

Try it. It is on Monday. There are four criteria for judging the first week.

If the date of the year is more than 4 days in the first week, the first of the year How to calculate as the 4th week (If less than 4 days, it will be the last week of the previous year)
How to calculate the first week of the year if there are 7 days in the first week of the year
How to calculate the date in January of this year as the first week of the year
How the computer system calculates itself

Also, the start date of the week may be different depending on the day of the week.

Depending on what criteria you have, it may appear different.

Function getWeekDay(rng As Range, y As Integer, blStart As Boolean)
    Dim s As Date, e As Date
    Dim i As Integer, k As Integer
    Dim n As Integer

    Application.Volatile
    'rng = Week number
    'y = 2016 'year
    'blStart 0: first day 1: last day

    s = DateSerial(y, 1, 0)
    e = DateSerial(y + 1, 1, 0)
    n = e - s
    For i = 1 To n
        d = s + i
        k = k + 1
        If DatePart("ww", d, vbMonday) = rng.Value Then
            If DatePart("ww", d, vbMonday) = DatePart("ww", d + 1, vbMonday) Then
            Else
                'k = k + 1
                If k = 1 Then
                    If blStart Then
                        getWeekDay = d
                    Else
                        getWeekDay = s + 1
                    End If
                   Exit Function
                Else
                    If blStart Then
                    getWeekDay = d
                    Else
                        getWeekDay = d - 6
                    End If
                    Exit Function
                End If
            End If
        End If
    Next i

End Function
Function getWeekDay2(rng As Range, y As Integer, blStart As Boolean)
    Dim s As Date, e As Date
    Dim i As Integer, k As Integer
    Dim n As Integer

    Application.Volatile

    'y = 2016 'y ~~> Year

    s = DateSerial(y, 1, 0)
    e = DateSerial(y + 1, 1, 0)
    n = e - s
    For i = 1 To n
        d = s + i
        k = k + 1
        If DatePart("ww", d, vbMonday) = rng.Value Then
            If DatePart("ww", d, vbMonday) = DatePart("ww", d + 1, vbMonday) Then
            Else
                'k = k + 1
                If k = 1 Then
                    If blStart Then
                        getWeekDay2 = Format(d, "yyyy-mm-dd")
                    Else
                        getWeekDay2 = Format(s + 1, "yyyy-mm-dd")
                    End If
                   Exit Function
                Else
                    If blStart Then
                    getWeekDay2 = Format(d, "yyyy-mm-dd")
                    Else
                        getWeekDay2 = Format(d - 6, "yyyy-mm-dd")
                    End If
                    Exit Function
                End If
            End If
        End If
    Next i

End Function
Function getWeekDay3(rng As Range, y As Integer)
    Dim s As Date, e As Date
    Dim i As Integer, k As Integer
    Dim n As Integer
    Application.Volatile

    'y = 2016 'y ~~> Year

    s = DateSerial(y, 1, 0)
    e = DateSerial(y + 1, 1, 0)
    n = e - s
    For i = 1 To n
        d = s + i
        k = k + 1
        If DatePart("ww", d, vbMonday) = rng.Value Then
            If DatePart("ww", d, vbMonday) = DatePart("ww", d + 1, vbMonday) Then
            Else
                If k = 1 Then
                        getWeekDay3 = Format(s + 1, "yyyy.mm.dd") & "~" & Format(d, "yyyy.mm.dd")
                   Exit Function
                Else
                    getWeekDay3 = Format(d - 6, "yyyy.mm.dd") & "~" & Format(d, "yyyy.mm.dd")
                    Exit Function
                End If
            End If
        End If
    Next i

End Function
Sub getWeekDays()
    Dim vDB, vS(), vR()
    Dim y As Integer, s As Date, e As Date
    Dim i As Integer, k As Integer
    Dim n As Integer

    'y = 2016 'y ~~> Year
    y = InputBox("input year")

    s = DateSerial(y, 1, 0)
    e = DateSerial(y + 1, 1, 0)
    n = e - s
    For i = 1 To n
    d = s + i
        If DatePart("ww", d, vbMonday) = DatePart("ww", d + 1, vbMonday) Then
        Else
            k = k + 1
            ReDim Preserve vR(1 To 2, 1 To k)
            vR(1, k) = DatePart("ww", d, vbMonday) & " Week"
            If k = 1 Then
                vR(2, k) = Format(s + 1, "yyyy.mm.dd") & "~" & Format(d, "yyyy.mm.dd")
            Else
                vR(2, k) = Format(d - 6, "yyyy.mm.dd") & "~" & Format(d, "yyyy.mm.dd")
            End If
        End If
    Next i
    Range("a1").CurrentRegion.Clear
    Range("a1").Resize(k, 2) = WorksheetFunction.Transpose(vR)
End Sub

image

A constant that determines the first week.

Constant for the start day of the week.

来源：https://stackoverflow.com/questions/60732616/get-a-weeknumbers-end-date-using-excel-macro

标签

excel

vba