在单元格中写入缓慢的 VBA 宏答案

【问题标题】：Slow VBA macro writing in cells在单元格中写入缓慢的 VBA 宏
【发布时间】：2015-09-01 12:21:33
【问题描述】：

我有一个 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 循环非常快（我将值写入了一些随机变量），所以我知道，写入单元格是一直占用的时间。

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

感谢您的宝贵时间。

【问题讨论】：

这样做ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr 其中arr 是some value 值的数组，例如Dim arr(1 to 100) as Long。或者如果可能的话ws.Range(Cells(firstRow, RowNumber), Cells(lastRow, Number))=twoDimensionalArray
可能值得考虑实施进度条。好吧，稍微把事情放下来，但要让用户放心，例程正在进行中。
我不知道这是否适用于你，但对我来说，我设置了.Value = ""。每个调用都占用了 30-40 毫秒（很小，但将其放入数百个项目的循环中！）。我把它改成了.ClearContents，现在调用需要0ms。

标签： vba excel ms-project

【解决方案1】：

是否可以写一整行而不是单个单元格？那会更快吗？

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

这是一个将 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

【讨论】：

非常好的代码示例。唯一的问题是，这只会写入 1000 的倍数的行。所以它会写入 29000 行，而不是 29300，因为它将构建 300 行并且 idx 将不等于 BlockSize - 1，所以最后 300 个将被转储。
@Laureant 哎呀，忘了那部分！代码已更新——只需要在 For 循环之后重复 3 行 With ws 语句即可。
这是否也适用于“断开连接”的单元格，例如A3，A7，A13，...？我有一个需要更新的单元格列表作为字符串（想想“A3”、“A7”、“A13”……）。
@Onur 不，您不能通过单个调用在不相交的范围上设置值，因为 Value 属性仅适用于范围对象的第一个 Area。
@RachelHettinger 感谢您提供信息。我假设我必须坚持使用单值分配然后......

【解决方案2】：

这样做：

ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr

其中 arr 是您的 some value 值的数组，例如

Dim arr(1 to 100) as Long

或者如果可能的话（甚至更快）：

ws.Range(Cells(firstRow, RowNumber), Cells(lastRow, Number))=twoDimensionalArray

其中twoDimensionalArray 是您的some value 值的二维数组，例如

Dim twoDimensionalArray(1 to [your last row], 1 to 12)  as Long

【讨论】：

Rachel 样本很棒，但它减少了这一点。用于单行更新或使用 2 dim 数组或多行更新。使用块更像是一种装饰，它会为相同的示例产生很多噪音，从而使这成为更好的答案。
这个答案非常适合将适量的数据移动到 Excel。然而，这不是 OP 的问题。当数据量很大时，分块写入数据不仅仅是装饰。在这种情况下，一次编写所有 29000 个任务所需的时间是将其分解成块的时间的两倍。

【解决方案3】：

我的情况是，我要填充巨大的表格，我必须逐个单元格，然后逐行。痛苦的慢。我仍然不确定为什么，但在我的循环之前我添加了：

cells(1,1).select

（如果这很重要，那就是我桌子外面的单元格-idk）并且速度显着提高了。我的意思是从 10 分钟到大约 30 秒。因此，如果您要写入表格中的单元格，请尝试一下。

我应该补充一点，我总是做的第一件事是禁用事件、屏幕更新和切换到手动计算。在我尝试这种解决方法之前，这没有帮助

【讨论】：

【解决方案4】：

之前的回答提到做cells(1,1).select。

我的建议是在更新循环之前执行Worksheets("Sheet2").Activate。

将上面的Sheet2 替换为任何未更新单元格的工作表。这会带来非常显着的改进。
即使您可以将应用程序 displayupdating 设置为 false，但更改已激活的工作表确实可以消除开销。

【讨论】：