将vba中2个日期之间的所有日期存储到数组中

Question

我正在使用一个函数来获取开始日期和结束日期列表中 2 个日期之间的所有日期：我希望将从开始日期到结束日期的每个日期及其唯一 ID 存储在数组中。数据为列 1 ID、2 开始日期、3 结束日期。该数组将是一个 ID 列表，其中包含从开始日期到结束日期的所有相关日期。下面是我必须获取所有日期的代码：

Sub Test_Dates()
'
Dim TESTWB As Workbook
Dim TESTWS As Worksheet

Set TESTWB = ThisWorkbook
Set TESTWS = TESTWB.Worksheets("TEST")

For i = 2 To TESTWS.Cells(1, 1).End(xlDown).Row

DatesTest = getDates(TESTWS.Cells(i, 2), TESTWS.Cells(i, 3))

Next i

End Sub


Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant

    Dim varDates()      As Date
    Dim lngDateCounter  As Long

    ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))

    For lngDateCounter = LBound(varDates) To UBound(varDates)
        varDates(lngDateCounter) = CDate(StartDate)
        StartDate = CDate(CDbl(StartDate) + 1)
    Next lngDateCounter

    getDates = varDates

ClearMemory:
    If IsArray(varDates) Then Erase varDates
    lngDateCounter = Empty

Answer 1

只需创建一个具有 ReDim DatesTest(1 To LastRow - FirstRow + 1) 行大小的数组，然后用 getDates 的结果填充该数组即可。

Dim TESTWB As Workbook
Dim TESTWS As Worksheet

Set TESTWB = ThisWorkbook
Set TESTWS = TESTWB.Worksheets("TEST")

Const FirstRow As Long = 2
Dim LastRow As Long
LastRow = TESTWS.Cells(1, 1).End(xlDown).Row

Dim DatesTest() As Variant
ReDim DatesTest(1 To LastRow - FirstRow + 1)

Dim i As Long
For i = FirstRow To LastRow
    DatesTest(i - FirstRow + 1) = getDates(TESTWS.Cells(i, 2), TESTWS.Cells(i, 3))
Next i

然后，您可以使用 DatesTest(1) 访问 getDates 的第一个结果，其中 DatesTest(1)(1) 应该为您提供第一组。

如果你想循环遍历所有这些，你可以这样做：

Dim DateSet As Variant
For Each DateSet In DatesTest  ' loop through all sets of dates
    Dim DateItem As Variant
    For Each DateItem In DateSet  ' loop through all dates of one set
        Debug.Print DateItem
    Next DateItem
Next DateSet

或者类似

Dim iSet As Long
For iSet = 1 To Ubound(DatesTest)  ' loop through all sets of dates
    Dim iDate As Long
    For iDate = 0 To Ubound(DatesTest(iSet))  ' loop through all dates of one set
        Debug.Print "Set " & iSet, "Date " & DatesTest(iSet)(iDate)
    Next iDate
Next iSet

这应该输出类似的内容

Set 1        Date 2022-03-08
Set 1        Date 2022-03-09
Set 1        Date 2022-03-10
Set 2        Date 2022-04-01
Set 2        Date 2022-03-02
Set 2        Date 2022-03-03
…

---

如果你想使用ID(i,1)作为键，那么你需要使用集合而不是数组。

Dim TESTWB As Workbook
Dim TESTWS As Worksheet

Set TESTWB = ThisWorkbook
Set TESTWS = TESTWB.Worksheets("TEST")

Const FirstRow As Long = 2
Dim LastRow As Long
LastRow = TESTWS.Cells(1, 1).End(xlDown).Row

DatesTest As New Collection

Dim i As Long
For i = FirstRow To LastRow
    DatesTest.Add getDates(TESTWS.Cells(i, 2), TESTWS.Cells(i, 3)), TESTWS.Cells(i, 1)
Next i

然后，您可以使用 DatesTest(TESTWS.Cells(2, 1)) 获取第一组日期和 DatesTest(TESTWS.Cells(2, 1))(1) > 会给你该组的第一个日期。