Question

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

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

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

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

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

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

谢谢，李

Answer 1

你需要一个简单的循环来传递起始范围，开始和放大结束时间和增量。我建议严格使用日期/时间;输出范围应格式化为时间

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表示法。< / p>

Loop Until中的1秒被添加，因为我发现循环过早地离开1次（似乎在循环内#16:0:0# < #16:0:0#解析为True）

Answer 2

您可以使用DateAdd来增加日期：http://www.techonthenet.com/excel/formulas/dateadd.php

Sub createTimeColumn()

intIncr = 60                                    'minutes to add each cell
intCellCnt = 1440 / intIncr                     '24h * 60m = 1440 minutes per day
datDate = CDate("01/11/2013 06:00:00")          'start date+time for first cell

For i = 1 To intCellCnt                         'loop through n cells
    Cells(i, 1) = Format(datDate, "hh:mm")      'write and format result
    datDate = DateAdd("n", intIncr, datDate)    'add increment value
Next i

End Sub

结果将如下所示

enter image description here

Answer 3

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

他们打败了我......但是因为我已经写了一个例程......不妨发布它：）

Answer 4

在新工作簿中尝试此操作

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

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

4 个答案: