VBA：根据一定范围的单元格和时间间隔填充“时间”列

我有一个Excel工作表，我需要填充范围是用户input的时间列中的单元格范围，时间间隔也是如此。

我可以使用For循环来实现这个function，但是可能会有〜50000个单元，写入这些单元需要很长时间。

我收集有一种方法来实现这个在VBA中通过创build一个范围的大小的数组，填充此数组，然后将数组复制到工作表？ 我对通用的C风格编程相当熟悉，但不是特别的VBA。

如果我的单元格安排在A1包含开始单元格（例如1）和B1包含结束单元格（例如100），A2包含开始时间（00:00:00）和B2包含时间间隔（00:05 ：00）我将如何使用VBA填充单元格D1：D100，如00:00:00，00:05:00，00:10:00 …等

（实际上，单元格引用是跨越页面和更大的范围，但我可以稍后进行sorting）。

提前致谢。

Answer 1

这里有一些不使用数组的VBA，但速度非常快。 它使用公式，然后粘贴它们作为值。 大约需要50,000秒的时间：

Sub FillColumn() Dim ws As Excel.Worksheet Dim FillRange As Excel.Range Dim FirstValue As Double Dim ValueIncrement As Double Dim FirstCell As Long Dim LastCell As Long Application.ScreenUpdating = False Set ws = ActiveSheet With ws FirstCell = .Range("A1") LastCell = .Range("B1") FirstValue = .Range("A2") ValueIncrement = .Range("B2") End With Set FillRange = ws.Range("D" & FirstCell).Resize((LastCell - FirstCell) + 1, 1) With FillRange .Cells(1) = FirstValue .Offset(1, 0).Resize(.Rows.Count - 1, 1).Formula = "=R[-1]C+" & ValueIncrement .Value = .Value .NumberFormat = "hh:mm:ss" End With Application.ScreenUpdating = True End Sub 

编辑：解释这一行.Offset(1, 0).Resize(.Rows.Count - 1, 1).Formula = "=R[-1]C+" & ValueIncrement

Offset(1,0)是指比FillRange低1行的范围，例如D2：D50001

.Resize(.Rows.Count - 1, 1)取前一行并缩短一行，例如D2：D50000

.Formula = "=R[-1]C+" & ValueIncrement将公式应用于该范围。 该公式只是说将ValueIncrement添加到上面的单元格中。 如果我在这行之后停止代码，公式看起来像=D1+0.0000578703703703704 。 我通过遵循迪克·库斯莱卡（Dick Kusleika）最优秀的技巧，得到了代码中使用的R1C1式公式。

这是一个数组版本。 5万人似乎有点快。 但是，由于Application.Transpose的限制，它仅适用于65536个元素。 我不确定是否有更好的方法来填充数组，即不使用循环：

 Sub FillColumn2() Dim ws As Excel.Worksheet Dim FillRange As Excel.Range Dim FirstValue As Double Dim ValueIncrement As Double Dim FirstCell As Long Dim LastCell As Long Dim arr As Variant Dim i As Long Application.ScreenUpdating = False Set ws = ActiveSheet With ws FirstCell = .Range("A1") LastCell = .Range("B1") FirstValue = .Range("A2") ValueIncrement = .Range("B2") End With ReDim arr(FirstCell To LastCell) arr(1) = FirstValue For i = FirstCell + 1 To LastCell arr(i) = arr(i - 1) + ValueIncrement Next i Set FillRange = ws.Range("D" & FirstCell).Resize((LastCell - FirstCell) + 1, 1) FillRange = Application.Transpose(arr) Application.ScreenUpdating = True End Sub