在vba中获取2个日期之间的所有日期答案

【问题标题】：Get all dates between 2 dates in vba在vba中获取2个日期之间的所有日期
【发布时间】：2015-05-20 01:59:48
【问题描述】：

我是 vba 的新手，我正在尝试获取两个日期之间的所有日期，例如，我将使用参数 01-01-2015 和 15-01-2015 调用该函数，然后我将进入返回一个包含所有可能日期的数组，即：

01-01-2015
02-01-2015
03-01-2015
.....
15-01-2015

我在论坛上没有找到答案，所以提前感谢您的帮助。

【问题讨论】：

该函数是打算将数组返回到 VBA 中的变体类型 var，还是试图将其返回到工作表以进行额外的本机函数处理？
根据用途和要求，您可以使用 Excel 中的过滤器实现相同的效果。
我需要得到一个包含所有日期的集合，因为我将在另一个 vba 函数中使用它。
您可以简单地将日期转换为 long 并进行循环（+1）并在 2 个日期之间获取所有日期（再次将其转换为日期）

标签： vba date excel

【解决方案1】：

您可以简单地将日期转换为 long 并循环（+1）并在 2 个日期之间获取所有日期（再次将其转换为日期）

Sub Calling()
    Dim test
    test = getDates(#1/25/2015#, #2/5/2015#)
End Sub

Function getDates(ByVal StartDate As Date, ByVal EndDate As Date) As Variant

    Dim varDates()      As Date
    Dim lngDateCounter  As Long

    ReDim varDates(1 To CLng(EndDate) - CLng(StartDate))

    For lngDateCounter = LBound(varDates) To UBound(varDates)
        varDates(lngDateCounter) = CDate(StartDate)
        StartDate = CDate(CDbl(StartDate) + 1)
    Next lngDateCounter

    getDates = varDates

ClearMemory:
    If IsArray(varDates) Then Erase varDates
    lngDateCounter = Empty

End Function

【讨论】：

感谢您的回答，它工作得很好，除了 enddate 被排除在集合之外。
哦修改这个：ReDim varDates(0 To CLng(EndDate) - CLng(StartDate))

【解决方案2】：

获取给定范围内所有日期的函数

Function GetDatesRange(dateStart As Date, dateEnd As Date) As Collection
    Dim dates As New Collection
    Dim currentDate As Date
    currentDate = dateStart
    Do While currentDate <= dateEnd
        dates.Add currentDate
        currentDate = DateAdd("d", 1, currentDate)
    Loop
    Set GetDatesRange = dates
End Function

示例用法

Dim dateStartCell as Range, dateEndCell as Range
Dim allDates as Collection
Dim currentDateSter as Variant
Dim currentDate as Date
Set dateStartCell = ActiveSheet.Cells(3, 3)
Set dateEndCell = ActiveSheet.Cells(3, 6)
Set allDates = GetDatesRange(dateStartCell.Value, dateEndCell.Value)    
For Each currentDateSter In allDates
    currentDate = CDate(currentDateSter)
    'Do something with currentDate
Next currentDateSter

【讨论】：

【解决方案3】：

一个数组 'sn' 包含从 01-01-2015 到 15-01-2015 的所有日期。引入 Msgbox 来说明结果。

Sub M_snb()
  sn = Evaluate("index(text(datevalue(""01-01-2015"")+row(1:" & DateDiff("d", CDate("01-01-2015"), CDate("15-01-2015")) & ")-1,""dd-mm-yyyy""),)")
  MsgBox sn(1, 1) & vbLf & sn(2, 1) & sn(UBound(sn), 1)
End Sub

【讨论】：

【解决方案4】：

也许是这样。

Function udf_Array_of_Dates(dtSTART As Date, dtEND As Date, rDATEs As Range)
    Dim dt() As Date, r As Range, d As Long
    For Each r In rDATEs
        If r.Value >= dtSTART And r.Value <= dtEND Then
            d = d + 1
            ReDim Preserve dt(1 To d)
            dt(d) = r.Value
        End If
    Next r
    udf_Array_of_Dates = dt
End Function

证明和语法：

【讨论】：

【解决方案5】：

如果您只想在 excel 中打印两个日期之间的日期，那么我的建议是您在代码下方尝试。

Sub DateFill()

Dim Start_Date As Date
Dim End_Date As Date
Dim Number_Of_Days As Integer


Start_Date = InputBox(prompt:="Enter the Start Date", Title:="Date Print", Default:="3/1/2013")
End_Date = InputBox(prompt:="Enter the End Date", Title:="Date Print", Default:="3/23/2013")

Range("A1").Value = Start_Date
'Range("B1").Value = End_Date
Range("A1").Select
Number_Of_Days = DateDiff("d", Start_Date, End_Date) ' Return Day

Number_Of_Days = Number_Of_Days + 1
'Range("C1").Formula = "=DATEDIF(A1, B1, ""D"") "


Selection.AutoFill Destination:=Range("A1:A" & Number_Of_Days), Type:=xlFillDefault
    Range("A1:A" & Number_Of_Days).Select


End Sub

这里你已经避免使用节省执行时间的循环。

【讨论】：