如何在Excel中的兩個給定日期之間每隔2小時列出所有日期

Question

在我的工作中，我必須處理Excel表格並在時間範圍之間收集數據。

到目前爲止我用下面的VBA代碼：

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 

但這個代碼只允許列出整天而不是小時。

例如，如果我輸入的日期範圍在01.01.2017和03.01.2017之間=>到列出的01.01.2017 02:00，然後01.01.2017 04:00依此類推......到2017年1月1日22:00 。

我試了幾次來編輯這段代碼，但我每次都把它弄壞了。我還嘗試刪除Inputboxes，以便從單元格B2和C2中讀取時間範圍的代碼，並在A17中作爲輸出，但仍然沒有成功。

我不是程序員，所以我嘗試閱讀一下VBA，但我明白這是需要學習很多。

如果有人已經嘗試過或知道如何提供幫助，我將非常感激。

Answer 1

您的代碼使用for循環「For i = StartValue To EndValue」來生成值，因此無法輸入您的2小時間隔。我的代碼使用endDate和startDate通過將endDate-startDate乘以12來計算需要多少行。如果間隔不容易計算，例如3小時，然後您可以將for循環更改爲while循環，以檢查值是否已達到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 

你也可以在excel中使用公式。把你的持續時間放在A1單元格（02:00），然後把你的開始日期放在B1（01/02/2017）和你的結束日期B2（01/03/2017）中，然後在B6中輸入= B1和在B7中= IFERROR IF（B6 + $ A $ 1 < = $ B $ 2，B6 + $ A $ 1，「」），「」）自動填充B7，只要您認爲您需要列表或更多內容以確保安全。現在，當您更改A1，B1或B2中的任何內容時，您的列表將自動更新。

Answer 2

這是添加額外輸入框的代碼，允許您指定小時間隔。如果值爲零，它將默認爲1天的時間間隔。我會留給你，以添加錯誤檢查空白單元格，負值等。

該算法是基於這樣一個事實，即Excel將日期/時間存儲爲日期和一天中的幾分之一。所以一小時= 1/24。由於For...Next循環要求整數step value我們乘以24生成連續值I，然後除以24輸出所需的值。

---

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 

---