Saya seorang pemula di vba dan saya mencoba memasukkan semua tanggal di antara 2 tanggal di vba, misalnya saya akan memanggil fungsi dengan parameter 01-01-2015 dan 01-15-2015, dan sebagai imbalannya saya akan mendapatkan array dengan semua tanggal yang memungkinkan, yaitu:
01-01-2015
02-01-2015
03-01-2015
.....
15-01-2015
Saya tidak menemukan jawabannya di forum, jadi terima kasih sebelumnya atas bantuan Anda.
Anda cukup mengonversi tanggal menjadi panjang dan membuat loop(+1) dan mendapatkan semua tanggal di antara 2 tanggal (konversikan menjadi tanggal lagi)
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
Berfungsi untuk mendapatkan semua tanggal dari rentang tertentu
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
Contoh penggunaan
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
Array 'sn' yang berisi semua tanggal dari 01-01-2015 hingga 15-01-2015. Msgbox diperkenalkan untuk mengilustrasikan hasilnya.
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
Mungkin ini.
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
Bukti & sintaksis:
Jika Anda hanya ingin mencetak tanggal antara dua tanggal di excel maka saran saya adalah Anda mencoba kode di bawah ini.
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
Di sini Anda menghindari penggunaan Loop yang menghemat waktu eksekusi.
