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

Excel VBA: Writing an array to cells is very slow

提问by Octavio

I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.

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

After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:

在我检索信息后，这个过程不超过 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

My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.

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

As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?

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

PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)

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

Thanks in advanced.

提前致谢。

回答by Octavio

This is what I did to improve the performance:

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

• Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
• I set the property Application.Calculation to xlCalculationManual

• Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.

  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
  

• 避免在要写入值时选择单元格。这是蒂姆·威廉姆斯的建议。
• 我将属性 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
  

Thank you all for your help!

谢谢大家的帮助！

回答by Jim Snyder

By not selecting the sheet, you can add a bit more speed. Instead of

通过不选择工作表，您可以增加一点速度。代替

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

Try

尝试

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