vba - 获取两个日期之间的日期数组
问题描述
我需要帮助创建两个日期之间的日期数组。我正在尝试使用 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
解决方案
下面的代码将创建包含开始和结束日期的数组。可以删除标记为 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
推荐阅读
- java - 让 find() 在 java 的正则表达式中找到不止一次
- react-native - React native - eslintrc - prettierrc:如何防止移除 JSX 中一个元素周围的括号
- c# - Caliburn.Micro 检测带有修饰符的文本框输入
- java - 如何在具有不同键的外部 hashMap 中传递具有相同键的内部 hashMap?
- julia - 如何向现有字典添加新的键值对?
- java - 可在室内流动
- html - CSS中两个div容器的交替换行符
- android - 如何在菜单顶部显示工具栏的标题
- android - Kotlin:如何使用 RecycleView + ViewAdapter 让不同的用户得到不同的 ViewHolders?
- python - Python“全部”执行