vba 给定开始日期和结束日期生成日期列表
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/21761451/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Generating a list of dates given the start and end dates
提问by Chardo
Previously I found some VBA code done by Andy Brown that generates a list and makes each date the first or 15th for another user. I have tried to adjust this code to my needs but I'm struggling. Currently the code, once run, is just putting in the same date over and over and I have to end Excel.
以前我发现了一些由 Andy Brown 完成的 VBA 代码，它生成一个列表并使每个日期成为另一个用户的第一个或第 15 个日期。我试图根据我的需要调整这段代码，但我很挣扎。目前，一旦运行，代码就会一遍又一遍地输入相同的日期，我必须结束 Excel。
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("A1").Value
LastDate = Range("a2").Value
NextDate = FirstDate
Range("B1").Select
Do Until NextDate >= LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
If Day(NextDate) = 1 Then
NextDate = DateAdd("d", NextDate, 14)
Else
NextDate = DateAdd("d", NextDate, 20)
NextDate = DateSerial(Year(NextDate), Month(NextDate), 1)
End If
Loop
Previous code I based my model upon is listed above and my, most likely terrible code, is below:
上面列出了我基于模型的以前的代码，而我最有可能的糟糕代码如下：
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
NextDate = FirstDate
Range("tripdays").Select
'selection of columns within one row
Do Until NextDate >= LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
If Day(NextDate) = 1 Then
NextDate = DateAdd("d", NextDate, 14)
End If
Loop
End Sub
What I need instead is to generate everydate between the given start and end dates, instead of just the 15th and 1st. How is this done?
我需要的是生成给定开始日期和结束日期之间的每个日期，而不仅仅是第 15 天和第 1 天。这是怎么做的？
采纳答案by Jerome Montino
EDIT:
编辑：
This is apparently what you need, as discussed in comments.
正如评论中所讨论的，这显然是您所需要的。
Sub GenerateDates()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
NextDate = FirstDate
Range("tripdays").Select
'selection of columns within one row
Do Until NextDate > LastDate
ActiveCell.Value = NextDate
ActiveCell.Offset(1, 0).Select
NextDate = NextDate + 1
Loop
End Sub
Alternatively, a Forloop would do just as well.
或者，For循环也可以。
Screenshot:
截屏：
FURTHER EDIT:
进一步编辑：
Horizontal version, as requested.
水平版本，根据要求。
Sub GenerateDatesH()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
Dim DateOffset As Range
Dim DateIter As Date
FirstDate = Range("startdate").Value
LastDate = Range("enddate").Value
Set DateOffset = Range("tripdays")
For DateIter = FirstDate To LastDate
DateOffset.Value = DateIter
Set DateOffset = DateOffset.Offset(0, 1)
Next DateIter
End Sub
Screenshot:
截屏：
Note:I've also fixed the vertical version to stop at the end date provided.
注意：我还修复了垂直版本以在提供的结束日期停止。
回答by CRondao
Avoid using select in code it is very inefficient :)
避免在代码中使用 select 是非常低效的 :)
Sub p()
Dim FirstDate As Date
Dim LastDate As Date
Dim NextDate As Date
Dim r As Long
FirstDate = Range("A1").Value
LastDate = Range("a2").Value
r = 1
Do
FirstDate = FirstDate + 1
Cells(r, 2) = FirstDate
r = r + 1
Loop Until FirstDate = LastDate
End Sub
to do it in a row replace cells(r,2) by cells(1, r) and start r=2
连续执行将 cell(r,2) 替换为 cell(1, r) 并开始 r=2
