Excel VBA：将数组写入单元格非常慢答案

【问题标题】：Excel VBA: Writing an array to cells is very slowExcel VBA：将数组写入单元格非常慢
【发布时间】：2012-11-29 12:37:31
【问题描述】：

我正在使用 Excel 中的 VBA 从 Reuters 3000 数据库中检索一些信息。我检索的数据是一个二维数组，其中一列保存日期，另一列保存数值。

在我检索信息后，这个过程不超过 2 秒，我想将此数据写入工作表。在工作表中，我有一列包含日期，而其他几列包含数值，每一列都包含同一类别的值。我遍历数组的行以获取日期和数值并将它们保存在变量中，然后在工作表的日期列上搜索日期，并在找到日期后写入值。这是我的代码：

Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)

Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant

Application.ScreenUpdating = False    
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"

For element = startElement To endElement
    instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
    Range(dateColumnRange).Select
    Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        c.offset(0, columnOffset).Value = instrumentValue            
    End If
Next element

Application.DisplayStatusBar = False

End Sub

我的问题是这个过程很慢，即使数组中只有 5 行，完成任务也需要大约 15 秒。由于我想多次重复这个过程（我从数据库中检索的每组数据一次），我想尽可能地减少执行时间。

如您所见，我正在禁用屏幕更新，这是提高性能的最常见操作之一。有人对我如何进一步减少执行时间有什么建议吗？

PS。我知道数据检索过程并不需要太多，因为我已经测试了该部分（检索数据后立即在 MsgBox 上显示值）

提前致谢。

【问题讨论】：

为什么你可以把整个范围放在一个二维数组中？然后在代码中进行处理并将其设置为范围？你能给我看一张你的数据表的照片吗，我试试看。
表格中有公式吗？如果这样做，您可能希望关闭计算。这让我在过去感到胃灼热。也许您可以为您的值创建一个哈希表并从线性数组中填充列表？我怀疑搜索是永远的。
在循环中使用 Find() 有时会很慢。如果您要查找许多单元格，则以仪器名称作为键并将每个仪器的范围作为值加载字典会快得多。而且您应该始终避免在代码中选择范围：您可以这样做c.Offset(0,colOffset).Value=instrumentValue
我会混合使用上述所有解决方案。从您正在搜索的范围内的工作表中获取所有数据，包括您要写入的数据。如果你这样做，关闭计算就没那么重要了，因为你只会写回电子表格一次。

标签： performance vba excel

【解决方案1】：

这是我为提高性能所做的：

避免在要写入值时选择单元格。这是蒂姆·威廉姆斯的建议。
我将属性 Application.Calculation 设置为 xlCalculationManual

我没有使用 Find() 函数来搜索日期，而是将工作表中的所有日期加载到一个数组中并遍历该数组以获取行号。事实证明这比 Find() 函数更快。

Private Function loadDateArray() As Variant

    Dim Date_Arr() As Variant

    Sheets("Data").Activate
    Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
    loadDateArray = Date_Arr

End Function

Private Function getDateRow(dateArray As Variant, dateToLook As Variant)

    Dim i As Double: Dim dateRow As Double

    For i = LBound(dateArray, 1) To UBound(dateArray, 1)
        If dateArray(i, 1) = dateToLook Then
            dateRow = i
            Exit For
        End If
    Next i

    getDateRow = dateRow

End Function

感谢大家的帮助！

【讨论】：

如果你的“比较”项目列表很大，我推荐一本字典。

【解决方案2】：

通过不选择工作表，您可以提高一点速度。而不是

Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr

试试

With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With

【讨论】：