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之间输入日期范围=＆gt;列出01.01.2017 02:00，然后01.01.2017 04:00依旧...到02.01.2017 22:00。

我尝试了几次编辑这段代码，但我每次都打破了它。我还试图删除输入框，以便代码从单元格B2和C2读取时间范围，在A17中读取输出但是再次没有成功。

我不是程序员，所以我尝试了解一下VBA，但我知道需要学习很多东西。

如果有人试过这个或者知道如何帮助我会非常感激。

Answer 1

您拥有的代码是使用for循环＆＃34; For i = StartValue To EndValue＆＃34;生成值，这样就无法输入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（2017年3月1日），然后在B6中输入= B1，在B7中输入IFERROR（如果（B6 + $ A $ 1＆lt; = $ B $ 2，B6 + $ A $ 1，＆＃34;＆＃34;），＆＃34;＆＃34;）自动填写B7，直到你认为你为止＆＃l; ll需要你的清单或更多是安全的。现在，当您更改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

如何在Excel中的两个给定日期之间每2小时列出所有日期

2 个答案: