Datetime VBA Excel根据给定的时间分辨率创建小时列（如日历中的小时列）

我需要在VBA中创建某种日历。 我需要创建一列小时数。两个相邻单元格之间的时间差由从文本文件读取的整数确定，该整数表示以分钟为单位的时间分辨率

例如-如果Res=60，小时列应如下所示：

12:00
13:00
14:00
 ...

12:00
12:30
13:00
13:30
14:00
 ....

如果Res=30，则小时列应如下所示：

12:00
13:00
14:00
 ...

12:00
12:30
13:00
13:30
14:00
 ....

我已经根据给定的结果计算了单元格的数量（如果Res=60，nCells=24，如果Res=30，nCells=48，依此类推）。我只是不知道如何创建小时列（当然是在VBA代码中）

谢谢，

---

Li

您需要一个简单的循环，将开始范围、开始和结束时间以及增量传递到该循环。我建议严格按照日期/时间工作；输出范围应设置为时间格式

Sub CallTest()
    FillIt [A1], #12:00:00 PM#, #1:00:00 PM#, #12:10:00 AM#
End Sub

Sub FillIt(RStart As Range, TStart As Date, TEnd As Date, Inc As Date)
Dim Idx As Integer, TLoop

    Idx = 1
    TLoop = TStart

    Do
        RStart(Idx, 1) = TLoop
        TLoop = TLoop + Inc
        Idx = Idx + 1
    Loop Until TLoop > TEnd + #12:00:01 AM# ' need to add 1 second to really
                                            ' break the loop where we want

End Sub

不要担心有点奇怪的

Inc

参数。。。。在VBA编辑器中，只需输入

#0:10:0#

。。。它将自动扩展为完整的24小时AM/PM符号

---

循环中的1秒直到被添加，因为我发现循环提前了1次（似乎在循环中

#16:0:0#<#16:0:0#

解析为

True

）

您需要一个简单的循环来传递开始范围、开始和结束时间以及增量。我建议严格按照日期/时间工作；输出范围应设置为时间格式

Sub CallTest()
    FillIt [A1], #12:00:00 PM#, #1:00:00 PM#, #12:10:00 AM#
End Sub

Sub FillIt(RStart As Range, TStart As Date, TEnd As Date, Inc As Date)
Dim Idx As Integer, TLoop

    Idx = 1
    TLoop = TStart

    Do
        RStart(Idx, 1) = TLoop
        TLoop = TLoop + Inc
        Idx = Idx + 1
    Loop Until TLoop > TEnd + #12:00:01 AM# ' need to add 1 second to really
                                            ' break the loop where we want

End Sub

不要担心有点奇怪的

Inc

参数。。。。在VBA编辑器中，只需输入

#0:10:0#

。。。它将自动扩展为完整的24小时AM/PM符号

---

循环中的1秒直到被添加，因为我发现循环提前了1次（似乎在循环中，

16:0:0

解析为

True

）

可以使用DateAdd来增加日期：

结果看起来像

Public Sub MakeTime(RangeA As Range, iRes As Long)
Dim dDate As Date
Dim rCell As Range
Dim X As Variant
Set rCell = RangeA
dDate = CDate(RangeA.Value)
Do
    dDate = DateAdd("n", iRes, dDate)
    Set rCell = rCell.Offset(1, 0)
    rCell.Value = dDate
Loop Until DateDiff("h", CDate(RangeA.Value), dDate) >= 24
End Sub

Sub test()
Call MakeTime(Sheet1.Range("A1"), 45)
End Sub

---

您可以使用DateAdd来增加日期：

结果看起来像

Public Sub MakeTime(RangeA As Range, iRes As Long)
Dim dDate As Date
Dim rCell As Range
Dim X As Variant
Set rCell = RangeA
dDate = CDate(RangeA.Value)
Do
    dDate = DateAdd("n", iRes, dDate)
    Set rCell = rCell.Offset(1, 0)
    rCell.Value = dDate
Loop Until DateDiff("h", CDate(RangeA.Value), dDate) >= 24
End Sub

Sub test()
Call MakeTime(Sheet1.Range("A1"), 45)
End Sub

他们打败了我。。。但既然我已经写了一个程序。。。不妨把它贴出来：）

---

他们打败了我。。。但既然我已经写了一个程序。。。不妨发布：）

在新工作簿中尝试此功能

Sub Main()

    ' ask for column input
    Dim myColumn As String
    myColumn = InputBox("Please enter the column letter where the hours will be stored")

        ' Clear the column
        Columns(myColumn & ":" & myColumn).ClearContents

    ' initial hour
    Dim firstHour As String
    firstHour = InputBox("Please enter the start time in the hh:mm format i.e. 12:00")

    ' interval
    Dim interval As Long
    interval = CLng(InputBox("Please enter the interval in minutes"))

    ' duration
    Dim duration As Long
    duration = CLng(InputBox("Please enter the duration (hrs)"))

    ' apply formatting to column
    Columns(myColumn & ":" & myColumn).NumberFormat = "hh:mm;@"

    ' enter the initial time into cell
    Range(myColumn & 1) = CDate(firstHour)

    ' fill in remaining hours / interval
    Dim i As Long
    For i = 1 To (60 / interval) * duration
        Range(myColumn & 1).Offset(i, 0) = DateAdd("n", interval, CDate(Range(myColumn & 1).Offset(i - 1, 0)))
    Next i

End Sub

---

在新工作簿中尝试此操作

Sub Main()

    ' ask for column input
    Dim myColumn As String
    myColumn = InputBox("Please enter the column letter where the hours will be stored")

        ' Clear the column
        Columns(myColumn & ":" & myColumn).ClearContents

    ' initial hour
    Dim firstHour As String
    firstHour = InputBox("Please enter the start time in the hh:mm format i.e. 12:00")

    ' interval
    Dim interval As Long
    interval = CLng(InputBox("Please enter the interval in minutes"))

    ' duration
    Dim duration As Long
    duration = CLng(InputBox("Please enter the duration (hrs)"))

    ' apply formatting to column
    Columns(myColumn & ":" & myColumn).NumberFormat = "hh:mm;@"

    ' enter the initial time into cell
    Range(myColumn & 1) = CDate(firstHour)

    ' fill in remaining hours / interval
    Dim i As Long
    For i = 1 To (60 / interval) * duration
        Range(myColumn & 1).Offset(i, 0) = DateAdd("n", interval, CDate(Range(myColumn & 1).Offset(i - 1, 0)))
    Next i

End Sub

---

实际上，如果A1中有

12:00

，当您向下拖动该单元格时，

13:00

和

14:00

将自动创建。同样，如果你在A1和A2中有<代码> 12:00 <代码> >代码> 12:30 < /代码>，当你拖拽我知道的时候发生同样的事情，但是我想在VBA中对它进行编码，考虑到时间分辨率……作为一个提示，考虑下面的内容。在A1中输入“12:00”，在A2中输入“13:00”，在A4中输入“=A2-A1”。你应该得到1:00的“结果”。现在，更改A4的格式-将其从“自定义h:mm”更改为“常规”。现在您看到的结果是0.0416666667。看起来大约4.2%4%是25分之一，也许这0.041是一小时所需的增量，当添加到时间/日期的数字表示中时。因此，如果将A1中的12:00转换为格式为“General”，则得到0.5，即

12/24=0.5

minsIncrement=（mins/60）/24。例如，30分钟=0.5/24=0.0208（A4的1/2）实际上是说，如果A1中有

12:00

，当您向下拖动该单元格时，

13:00

和

14:00

将自动创建。同样，如果你在A1和A2中有<代码> 12:00 <代码> >代码> 12:30 < /代码>，当你拖拽我知道的时候发生同样的事情，但是我想在VBA中对它进行编码，考虑到时间分辨率……作为一个提示，考虑下面的内容。在A1中输入“12:00”，在A2中输入“13:00”，在A4中输入“=A2-A1”。你应该得到1:00的“结果”。现在，更改A4的格式-将其从“自定义h:mm”更改为“常规”。现在您看到的结果是0.0416666667。看起来大约4.2%4%是25分之一，也许这0.041是一小时所需的增量，当添加到时间/日期的数字表示中时。因此，如果将A1中的12:00转换为格式为“General”，则得到0.5，即

12/24=0.5

minsIncrement=（mins/60）/24。即30分钟=0.5/24=0.0208（A4的1/2）谢谢，但我不确定如何仅使用时间分辨率来执行此操作。是的，我有开始时间，但我希望能够为我阅读的每个决议创建一个时间列。例如，如果分辨率为30分钟，开始时间为12:00，我希望第二个单元格显示12:30，最后一个单元格显示11:30。但如果分辨率为60分钟，我希望第二个单元格显示13:00，最后一个单元格显示11:00。因此，只需从工作表中读取开始时间，并将其传递给函数。。。并相应地使用其他参数（如

TEnd=TStart+#12:0:0

）。。。这是一个编程平台。。。现在表现出一些努力；）谢谢，但我不知道如何仅使用时间分辨率来实现这一点。是的，我有开始时间，但我希望能够为我阅读的每个决议创建一个时间列。例如，如果分辨率为30分钟，开始时间为12:00，我希望第二个单元格显示12:30，最后一个单元格显示11:30。但如果分辨率为60分钟，我希望第二个单元格显示13:00，最后一个单元格显示11:00。因此，只需从工作表中读取开始时间，并将其传递给函数。。。并相应地使用其他参数（如

TEnd=TStart+#12:0:0

）。。。这是一个编程平台。。。现在表现出一些努力；）