如何在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 等等……到 02.01.2017 22:00。

我尝试了几次来编辑这段代码，但每次都失败了。我还尝试删除输入框，以便代码从单元格 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

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

---