vba - 获取 2 个日期之间的日期数组

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

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

编辑:编辑结束循环以使其看起来更好。

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