In my work I have to deal with Excel tables and gather data between time ranges.
Till now I used the following VBA code:
Sub WriteDates()
'Updateby20150305
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim StartValue As Variant
Dim EndValue As Variant
xTitleId = "KutoolsforExcel"
Set StartRng = Application.Selection
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type: = 8)
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type: = 8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type: = 8)
Set OutRng = OutRng.Range("A1")
StartValue = StartRng.Range("A1").Value
EndValue = EndRng.Range("A1").Value
If EndValue - StartValue <= 0 Then
Exit Sub
End If
ColIndex = 0
For i = StartValue To EndValue
OutRng.Offset(ColIndex, 0) = i
ColIndex = ColIndex + 1
Next
End Sub
But this code allows only to list whole days and not by hours.
For example if I enter date range between 01.01.2017 and 03.01.2017 => to list 01.01.2017 02:00, then 01.01.2017 04:00 and so on ... to 02.01.2017 22:00.
I tried a few times to edit this code but I just broke it every time. I also tried to remove the Inputboxes so that the code to reads from Cells B2 and C2 the time range and in A17 to be the output but again no success.
I am not a programmer so I tried by reading a bit about VBA but I understood that is needed to learn a lot.
If someone has tried this or knows how to help I will be very grateful.
The code you have is using the for loop "For i = StartValue To EndValue" to generate the values so there is nowhere to enter your 2 hour interval. My code uses the endDate and startDate to calculate how many rows you will need by multiplying by endDate-startDate by 12. if the interval was not as easy to calculate eg 3 hours then you could change the for loop to a while loop that checks if the value has reached the endDate.
Sub WriteDates()
'Updateby20150305
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim StartValue As Variant
Dim EndValue As Variant
xTitleId = "KutoolsforExcel"
Set StartRng = Application.Selection
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
StartValue = StartRng.Range("A1").Value
EndValue = EndRng.Range("A1").Value
If EndValue - StartValue <= 0 Then
Exit Sub
End If
ColIndex = 0
intRows = (EndValue - StartValue) * 12 ' number of times you need to loop to get 2 hour intervals 24/2
OutRng.Offset(0, 0) = StartValue ' put start value in the range
OutRng.Offset(0, 0).NumberFormat = "dd/mm/yyyy hh:mm" 'set the format
For RowIndex = 1 To intRows ' loop from 1 to intRows
OutRng.Offset(RowIndex, 0) = OutRng.Offset(RowIndex - 1, 0) + CDate("02:00:00") 'put the value above + 2 hours
OutRng.Offset(RowIndex, 0).NumberFormat = "dd/mm/yyyy hh:mm" ' set the format so that you can see the hours
Next
End Sub
You can also use a formula in excel. Put your duration in cell A1 (02:00) then put your start date in B1 (01/02/2017) and your end date in B2 (01/03/2017) then in B6 enter =B1 and in B7 =IFERROR(IF(B6+$A$1<=$B$2,B6+$A$1,""),"") autofill B7 down as far as you think you'll need for your list or much more to be safe. Now when you change anything in A1, B1 or B2, your list will automatically update.
Here is code that adds an extra input box to allow you to specify the hourly interval. If the value zero, it will default to 1 day interval. I will leave it to you to add in error checking for blank cell, negative values, etc.
The algorithm is based on the fact that Excel stores dates/times as days and fractions of a day. So one hour = 1/24. Since a For...Next
loop requires an integer for step value
we multiply by 24 to generate sequential values of I
, and then divide by 24 to output the desired value.
Option Explicit
Sub WriteDates()
'Updateby20150305
Dim rng As Range
Dim StartRng As Range
Dim EndRng As Range
Dim OutRng As Range
Dim IntvlHrsRng As Range
Dim IntvlHrs As Long
Dim StartValue As Variant
Dim EndValue As Variant
Const xTitleId As String = "KutoolsforExcel"
Dim ColIndex As Long
Dim I As Long
Set StartRng = Application.Selection
Set StartRng = Application.InputBox("Start Range (single cell):", xTitleId, StartRng.Address, Type:=8)
Set EndRng = Application.InputBox("End Range (single cell):", xTitleId, Type:=8)
Set IntvlHrsRng = Application.InputBox("Interval (Hours) (singlecell)", xTitleId, Type:=8)
Set OutRng = Application.InputBox("Out put to (single cell):", xTitleId, Type:=8)
Set OutRng = OutRng.Range("A1")
StartValue = StartRng.Range("A1").Value
EndValue = EndRng.Range("A1").Value
IntvlHrs = IntvlHrsRng.Range("A1").Value
If IntvlHrs = 0 Then IntvlHrs = 24
If EndValue - StartValue <= 0 Then
Exit Sub
End If
ColIndex = 0
For I = StartValue * 24 To EndValue * 24 Step IntvlHrs
OutRng.Offset(ColIndex, 0) = I / 24
ColIndex = ColIndex + 1
Next I
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.