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

Question

我正在使用Excel中的VBA从路透社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
  

感谢大家的帮助!