获取两个日期之间的日期数组

Question

我需要帮助来创建两个日期之间的日期数组。我正在尝试使用 Exceptions 对象从 MS Project 日历中导出假期。但是，每个 Calendar.Exception 都不是一个日期。它们可以定义为一个日期范围（例如圣诞节假期）。

Sub ArrayOfDates()
    Dim StartDate As Date, EndDate As Date, aDates() As Date
    StartDate = #1/1/2018#
    EndDate = #1/31/2018#

    'create array of dates inclusive of endpoints
    If EndDate > StartDate Then

    End If

End Sub

感谢所有建议。我采用了消除数组的方法：

Sub ExportCalendarHolidays()
    Dim calThisPrjCalendar As Calendar, excPeriod As Exception, OutputFileName As String, sOutputLine As String
    Dim Period As Date

    Set calThisPrjCalendar = ActiveProject.Calendar

    OutputFileName = ActiveProject.Path & "\" & "Holidays_" & Format(Now(), "yyyy-mm-dd_hhmmss") & ".csv"
    Open OutputFileName For Output As #1

    For Each excPeriod In calThisPrjCalendar.Exceptions
        For Period = excPeriod.Start To excPeriod.Finish
            sOutputLine = Format(Period, "mm/dd/yyyy")
            Print #1, sOutputLine
        Next Period
    Next

    'Cleanup
    Close #1
End Sub

Answer 1

下面的代码将创建包含开始和结束日期的数组。可以删除标记为 Debug 的行。最后的循环只是为了验证日期。

编辑：编辑结束循环看起来更好。

Sub ArrayOfDates()
    Dim StartDate As Date, EndDate As Date, aDates() As Date
    Dim x As Long, y As Long, totalDates As Integer
    StartDate = #1/1/2018#
    EndDate = #1/31/2018#
    DateLoop = StartDate
    totalDates = DateDiff("d", StartDate, EndDate)
    ReDim aDates(totalDates)
    x = 0
    Do While DateLoop <= EndDate
        aDates(x) = DateLoop
        Cells(x + 1, 1).Value = DateLoop ' Debug Line
        DateLoop = DateAdd("d", 1, DateLoop)
        x = x + 1
    Loop
    For y = 0 To UBound(aDates)
        Cells(y + 1, 3).Value = aDates(y) ' Debug Line
        Cells(y + 1, 4).Value = "Array Spot: " & y 'Debug Line
    Next y
End Sub

Answer 2

要获取所有日期，您可以执行类似的操作。

Dim dtDate as Date, dtStartDate as date, dtEndDate as Date

dtStartDate = #1/1/2018#
dtEndDate = #1/31/2018#

For dtDate = dtStartDate To dtEndDate
    'code to do each date
Next dtDate