vba - 在单元格中写入 VBA 宏速度缓慢

Question

我有一个 VBA 宏，可以将数据写入已清除的工作表中，但速度非常慢!

我正在从 Project Professional 实例化 Excel。

Set xlApp = New Excel.Application
xlApp.ScreenUpdating = False
Dim NewBook As Excel.WorkBook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
     .Title = "SomeData"
     Set ws = NewBook.Worksheets.Add()
     ws.Name = "SomeData"
End With

xlApp.Calculation = xlCalculationManual 'I am setting this to manual here

RowNumber=2
Some random foreach cycle
    ws.Cells(RowNumber, 1).Value = some value
    ws.Cells(RowNumber, 2).Value = some value
    ws.Cells(RowNumber, 3).Value = some value
             ...............
    ws.Cells(RowNumber, 12).Value = some value
    RowNumber=RowNumber+1
Next

我的问题是，foreach 循环有点大。最后，我将得到大约 29000 行。在一台相当不错的计算机上完成此操作需要超过 25 分钟。

有什么技巧可以加快写入单元格的速度吗？我已完成以下操作:

xlApp.ScreenUpdating = False
xlApp.Calculation = xlCalculationManual

我是否以错误的方式引用单元格？是否可以写入整行而不是单个单元格？

这样会更快吗？

我已经测试了我的代码，foreach 循环运行得非常快(我将值写入了一些随机变量)，所以我知道，写入单元格占用了所有这些时间。

如果您需要更多信息、代码片段，请告诉我。

感谢您的宝贵时间。

Answer 1

Would it be possible, to write in a whole row, instead of the single cells? Would that be faster?

是的，是的。这正是您可以提高性能的地方。众所周知，读取/写入单元格的速度很慢。您正在读取/写入多少个单元格并不重要，重要的是您为此对 COM 对象进行了多少次调用。因此，使用二维数组以 block 的形式读取和写入数据。

以下是将 MS Project 任务数据写入 Excel 的示例过程。我模拟了一个包含 29,000 个任务的时间表，它在几秒钟内运行。

Sub WriteTaskDataToExcel()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True

Dim NewBook As Excel.Workbook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
     .Title = "SomeData"
     Set ws = NewBook.Worksheets.Add()
     ws.Name = "SomeData"
End With

xlApp.ScreenUpdating = False
Dim OrigCalc As Excel.XlCalculation
OrigCalc = xlApp.Calculation
xlApp.Calculation = xlCalculationManual

Const BlockSize As Long = 1000
Dim Values() As Variant
ReDim Values(BlockSize, 12)
Dim idx As Long
idx = -1
Dim RowNumber As Long
RowNumber = 2
Dim tsk As Task
For Each tsk In ActiveProject.Tasks
    idx = idx + 1
    Values(idx, 0) = tsk.ID
    Values(idx, 1) = tsk.Name
    ' populate the rest of the values
    Values(idx, 11) = tsk.ResourceNames
    If idx = BlockSize - 1 Then
        With ws
            .Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
        End With
        idx = -1
        ReDim Values(BlockSize, 12)
        RowNumber = RowNumber + BlockSize
    End If
Next
' write last block
With ws
    .Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
End With
xlApp.ScreenUpdating = True
xlApp.Calculation = OrigCalc

End Sub