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