如何在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 

---