给出开始日期和结束日期的日期列表

Question

之前我发现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

上面的代码我的模型基于上面列出，我的，很可能是可怕的代码，如下：

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

我需要的是在给定的开始和结束日期之间生成 每个 日期，而不仅仅是15日和1日。这是怎么做到的？

Answer 1

修改

这显然是您所需要的，正如评论中所讨论的那样。

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

或者，For循环也可以。

<强>截图：

进一步编辑：

横向版本，视要求而定。

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

<强>截图：

注意：我还修复了垂直版本，以便在提供的结束日期停止。

Answer 2

避免在代码中使用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 

连续执行，用单元格（1，r）替换单元格（r，2）并启动r = 2