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

要获得所有日期，你可以做类似的事情。

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

Answer 2

下面的代码将创建包含开始和结束日期的数组。标记为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

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

2 个答案: