Question

我有一个excel工作表，我需要在时间列中填充一系列单元格，其中范围是用户输入，时间间隔也是如此。

我可以使用For循环来实现这一点，但可能会有大约50000个单元格，并且写入每个单元格需要很长时间。

我认为有一种方法可以在VBA中实现这一点，方法是创建一个数组，该数组是范围的大小，填充此数组，然后将数组复制到工作表中？我对一般的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 ......等等。

（实际上，单元格引用是跨纸张和更大的范围，但我可以稍后对其进行排序。）

提前致谢。

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。我按照这个most excellent tip by Dick Kusleika获得了代码中使用的R1C1式公式。

这是一个阵列版本。 50,000点似乎要快一点。但是，由于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

VBA：根据一系列单元格和间隔填充“时间”列

1 个答案: