Проблема с номерами недель между датами в Новый год

Проблема

Следующий [mcve] выведет массив массивов номеров недель между двумя датами. Это работает, когда обе даты относятся к одному году, однако в некоторых годах 52 недели, и они начинаются в последние дни прошлого года. А у других 53 недели.

Примером 52 недель является календарь на 2020 год:

Где первая неделя начинается 30 декабря.

Примером 53 недель является календарь на 2016 год:

Это начнется только 4 января.

Код

Следующий код закомментирован и выводит массив массивов с номерами недель.

Sub w_test()
    Dim Arr() As Variant, ArrDateW() As Variant
    'Initial Date
    DateI = DateSerial(2015, 5, 5)
    'Final Date
    DateF = DateSerial(2017, 9, 20)
    'Difference in weeks between DateI and DateF
    weekDif = DateDiff("ww", DateI, DateF) + k - 1

    i = Weekday(DateI)
    d = DateI

    'If not Sunday, go back to last week, to start the loop
    If i <> 1 Then
        d = DateAdd("d", -(i - 1), d)
    End If

    ReDim ArrDateW(weekDif)
    ReDim Arr(2)
    'Loop on all weeks between two dates to populate array of arrays
    For i = 0 To weekDif
        'Date
        Arr(0) = d
        'Trying to solve problem with New Year
        If Application.WorksheetFunction.WeekNum(d) = 53 Then
            flag = True
        End If
        If flag = False Then
            Arr(1) = Application.WorksheetFunction.WeekNum(d)
        Else
            Arr(1) = Application.WorksheetFunction.WeekNum(DateSerial(Year(d) + 1, 1, 1))
            flag = False
        End If

        'Year
        Arr(2) = Year(d)
        'Populate array of arrays
        ArrDateW(i) = Arr
        'Next Week Number
        d = DateAdd("ww", 1, d)
    Next i

    'To stop with Ctrl+F8
    Debug.Print d
End Sub

Вопрос

В 2015 году было 53 недели, однако программа дает следующие результаты:

А между 2016 и 2017 на выходе получается беспорядок:

Как исправить программу, чтобы эти номера недель выводились правильно?

danieltakeshi 08.07.2019 источник

comment

Вы пробовали использовать условную инициализацию arrDateW (33) (2) = 53, если год 2015? Можно ли это сделать с помощью этой переменной? - Karlomanio 08.07.2019

comment

Я хочу сделать его динамичным, чтобы работать над ним каждый год, как и в 2020 году. Были дни, когда я застревал на этом ... и не мог нормально думать, поэтому я задал вопрос, чтобы получить отзывы или ответы. - danieltakeshi 08.07.2019

comment

Как я вижу, вы можете: а) автоматизировать его по годам, создавая условный язык для инициализации этой переменной, который изменяет значение переменной в вашем цикле по году ИЛИ б) использовать другую логику, отличную от недель в году. - Karlomanio 08.07.2019

comment

Как бы вы это ни выразились, 365 [0,25] дней никогда не разделятся на группы по 7 дней. Ритейлеры решили эту проблему более века назад, разделив год на 4 квартала по 13 недель в каждом (3-4-3 недели в месяц соответственно) и добавив 53-ю неделю каждые пару лет; Таким образом, еженедельные продажи всегда сопоставимы по сравнению с прошлым годом. Неделя 53 просто сравнивается с неделей 1, если она присутствует; подумайте о том, чтобы иметь календарную таблицу, которая содержит метаданные для каждой даты (DayOfWeek, WeekOfYear, WeekOfMonth, MonthOfYear, MonthOfQuarter и т. д.) - тогда вы сможете агрегировать время и сравнивать что угодно. - Mathieu Guindon 08.07.2019

Ответы (1)

arrow_upward
1
arrow_downward

Я поступил иначе, полагаясь на встроенные функции VBA для правильного расчета номеров недель. Прочтите о номерах недель ISO в этом ответе и посмотрите, как я использую функцию DataPart - хотя вы можете заменить ее своим версия функции номера недели ISO Рона де Брюина, если вы считаете, что это оправдано.

Пара небольших заметок:

Всегда используйте Option Explicit
Попробуйте использовать более информативные имена переменных. ВЫ знаете, о чем говорите СЕЙЧАС. Через несколько месяцев вам будет сложно вспомнить, что означают d и Arr (даже если сейчас это кажется очевидным). Это просто хорошая привычка, которая делает код самодокументированным.
В приведенном ниже примере логика разбита на отдельную функцию с необязательным параметром (просто для удовольствия), который позволит вызывающему абоненту изменить начало недели на другой день.

Модуль кода:

Option Explicit

Sub w_test()
    Dim initialDate As Date
    Dim finaldate As Date
    initialDate = #5/5/2015#
    finaldate = #9/29/2017#

    Dim weeks As Variant
    weeks = WeekNumbers(initialDate, finaldate)

    Debug.Print "There are " & UBound(weeks, 1) & " weeks between " & _
                Format(initialDate, "dd-mmm-yyyy") & " and " & _
                Format(finaldate, "dd-mmm-yyyy")
End Sub

Private Function WeekNumbers(ByVal initialDate As Date, _
                             ByVal finaldate As Date, _
                             Optional ByVal weekStart As VbDayOfWeek = vbSunday) As Variant
    Dim numberOfWeeks As Long
    numberOfWeeks = DateDiff("ww", initialDate, finaldate, weekStart, vbFirstFullWeek)

    Dim startOfWeek As Date
    If Weekday(initialDate) <> vbSunday Then
        Dim adjustBy As Long
        If Weekday(initialDate) > weekStart Then
            adjustBy = Weekday(initialDate) - weekStart
        Else
            adjustBy = (Weekday(initialDate) + 7) - weekStart
        End If
        startOfWeek = DateAdd("d", -adjustBy, initialDate)
    End If

    Dim allTheWeeks As Variant
    ReDim allTheWeeks(1 To numberOfWeeks)

    Dim weekInfo As Variant
    ReDim weekInfo(1 To 3)

    Dim i As Long
    For i = 1 To numberOfWeeks
        weekInfo(1) = startOfWeek
        weekInfo(2) = DatePart("ww", startOfWeek, weekStart, vbFirstFourDays)
        weekInfo(3) = Year(startOfWeek)
        allTheWeeks(i) = weekInfo
        startOfWeek = DateAdd("ww", 1, startOfWeek)
    Next i

    WeekNumbers = allTheWeeks
End Function

PeterT 08.07.2019

comment

Я обновил код в ответе, чтобы учесть все случаи, когда день недели является днем 1. Если вы измените параметр weekStart на vbMonday, он даст вам неделю 53 для week(35). - PeterT; 08.07.2019

Проблема с номерами недель между датами в Новый год