Excel 新年日期之间的周数问题 问题

以下[mcve]将输出两个日期之间的周数数组。当两个日期都在同一年时，它就起作用了。然而，有些年份有52周，从去年的最后几天开始。其他人有53周

52周的一个例子是：

第一周从12月30日开始

53周的例子是：

那只从1月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周，但该计划输出以下内容：

在这两者之间，输出是一团混乱：

---

如何修复程序以正确输出这些周数？我的做法有些不同，依靠内置的VBA函数来正确计算周数。阅读ISO week numbers is，了解我是如何使用DataPart函数的——不过如果您觉得有必要，您可以替换自己版本的

几个简短的旁注：

尝试使用更具描述性的变量名。你知道你现在在说什么。再过几个月，你就很难记住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

---

如果年份是2015年，您是否尝试过使用arrDateW332=53的条件初始化？这可以用这个变量来完成吗？我想让它成为动态的，每年都在工作，就像2020年一样。这几天我都被困在这上面了。。。不能正确思考，所以我问了一个问题以获得反馈或答案。在我看来，你可以一年一次地自动化它，使用条件语言来初始化该变量——即一年一次地改变循环中变量的值，或者使用一年中除周之外的另一种逻辑。不管你怎么说，365[.25]天永远不会很好地分成7天一组。零售商在一个多世纪前就解决了这个问题，他们将一年分成4个季度，每个季度13周，每个月3-4-3周，每两年增加53周；这样一来，每周销售额每年都是可比的。第53周仅与第1周进行比较；考虑一个日历表，它包含每个日期、星期、星期、星期、月、月、季等的元数据，然后你就可以对时间进行汇总和比较。在所有的情况下，我更新了答案，其中一周中的哪一天是第1天。如果您将weekStart参数更改为vbMonday，它将为您提供第53周的第35周。