Получить дату окончания WeekNumber с помощью макроса Excel

Question

У меня есть 3 столбца: Year, Weeknum, WeekRange. Мне бы хотелось, чтобы в столбце WeekRange отображались даты начала и окончания, основанные на значениях Year и WeekNum. Я нашел код, который вычисляет дату начала, и он отлично работает, но я не могу найти ничего, что показывает, как получить дату окончания.

вот код, который я нашел (при условии, что WeekNumber равен 4, а год - 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

Благодарим за любую помощь, которую я могу получить.

Answer 1

Вот формульное решение (VBA не требуется).

Предполагается:

Ячейка A2 имеет год.

Ячейка B2 имеет номер недели .

Используйте эту формулу, чтобы получить 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")

Выше также предполагается, что вы предпочитаете, чтобы началом недели было воскресенье. Если вы предпочли бы начало недели понедельником, используйте вместо этого ...

=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")

Наконец, вы можете изменить формат даты, настроив вхождения "mm/dd/yy" в соответствии со своими потребностями.

Answer 2

Попробуй. Это в понедельник. Существует четыре критерия для оценки первой недели.

1. Если дата года превышает 4 дня в первой неделе, первое число года Как рассчитать 4-ю неделю (если меньше чем 4 дня, это будет последняя неделя предыдущего года)
2. Как рассчитать первую неделю года, если в первой неделе года 7 дней
3. Как вычислите дату в январе этого года как первую неделю года
4. Как компьютерная система рассчитывает себя

Кроме того, дата начала недели может отличаться в зависимости от день недели.

В зависимости от того, какие у вас критерии, он может выглядеть по-разному.

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

изображение

Константа, определяющая первую неделю.

Константа для начального дня недели.