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

Question

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

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

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

Answer 1

你可以简单地将日期换成长期并制作循环（+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

Answer 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

Answer 3

也许这就是。

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

证明＆amp;语法：

Answer 4

包含2015年1月1日至2015年1月15日期间所有日期的数组'sn'。 引入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

Answer 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

这里你可以避免使用Loop来节省执行时间。