Получите все даты между 2-х датами в vba

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 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 

Proof & Синтаксис:

Answer 3

Массив 'зп', содержащий все даты от 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 

Answer 4

Если вы хотите распечатать даты между двумя датами в 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, который сохраняет время выполнения.

Answer 5

Функции, чтобы получить все даты из заданного диапазона

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