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

Question

我正在使用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上显示值）

提前致谢。

Answer 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 

谢谢大家的帮助！

Answer 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