从 2 个输入日期获取所有 weeknums 并将它们放入一个数组中？

Question

由于我在上一篇文章中问了一个错误的问题，但仍然有很多改进（我已经在 Excel 中创建了一个计划表，如果有人想要我会很乐意分享），这就是我想要做的：单元格 B2：开始日期 和 单元格 B3：结束日期

示例：
B2 --> 2019 年 11 月 3 日
B3 --> 22/04/2019

在这个社区的帮助下，这是我的代码

Option Explicit

Sub Sample()

Dim sDate As Date, eDate As Date
Dim NoOfWeeks As Long
Dim arr As Variant
Dim i As Long
Dim myCellToStart As Range
Set myCellToStart = Worksheets(1).Range("D4")

Dim myVar As Variant
Dim myCell As Range
Set myCell = myCellToStart

With Worksheets("Foglio1")
    sDate = .Range("B2")

    If Weekday(sDate, vbMonday) <> 1 Then
        sDate = DateAdd("d", 7 - Weekday(sDate, vbMonday) + 1, sDate)
        NoOfWeeks = 1
    End If

    eDate = .Range("B3")
End With

If sDate = eDate Then
    NoOfWeeks = NoOfWeeks + 1
Else
    NoOfWeeks = NoOfWeeks + WorksheetFunction.RoundUp((eDate - sDate) / 7, 0)
End If

ReDim arr(1 To NoOfWeeks)
For i = 1 To NoOfWeeks
    arr(i) = i
Next i

End Sub

基本上，使用我当前的代码，我将获得一个具有以下输出的数组：arr(1, 2, 3, 4, 5, 6)

与此相关 --> See Calendar

我想获取：arr(11, 12, 13, 14, 15, 16, 17)

Answer 1

使用Application.WeekNum 会简单得多：

Option Explicit
Sub Test()

    Dim StartDate As Date, EndDate As Date

    With ThisWorkbook.Sheets("Foglio1") 'remember to fully qualify your ranges, including the workbook
        StartDate = .Range("B2")
        EndDate = .Range("B3")
    End With

    Dim StartWeek As Long, EndWeek As Long
    StartWeek = Application.WeekNum(StartDate, 2)
    EndWeek = Application.WeekNum(EndDate, 2)

    Dim arr
    Dim i As Long
    ReDim arr(StartWeek To EndWeek)
    For i = StartWeek To EndWeek
        arr(i) = i
    Next

End Sub

Answer 2

这是另一种方式：

Sub Test()

Dim StrtD As Long, EndD As Long
Dim arr As Variant

With Sheets("Foglio1")
    StrtD = Application.WeekNum(.Cells(1, 2).Value, 2)
    EndD = Application.WeekNum(.Cells(2, 2).Value, 2)
    arr = Application.Transpose(.Evaluate("ROW(" & StrtD & ":" & EndD & ")"))
End With

End Sub

Application.Transpose() 创建一个可以通过arr(x) 调用的一维数组，其中 x 是数组中的任意位置。如果你想创建一个二维数组，你可以离开转置。

---

要不使用 .Transpose 而是使用 .Columns 返回一维数组，您可以将代码调整为：

Sub Test()

Dim StrtD As Long, EndD As Long
Dim arr As Variant

With Sheets("Foglio1")
    StrtD = Application.WeekNum(.Cells(1, 2).Value, 2)
    EndD = Application.WeekNum(.Cells(2, 2).Value, 2)
    arr = .Evaluate("COLUMN(" & .Cells(1, StrtD ).Address & ":" & .Cells(1, EndD ).Address & ")")
End With

End Sub

我想这是一个偏好问题，因为两种方式都会返回一个数组 > arr(11, 12, 13, 14, 15, 16, 17)