如何优化VBA中ADODB连接以提升Excel数据查询性能

Great question—repeatedly opening ADODB connections is a huge performance drain, especially when you're running lots of price queries. Let's break down a few solid solutions to fix this, similar to how you'd reuse a DataFrame in Python:

Instead of creating a new connection every time your function runs, declare a global connection object that you initialize once. All your query functions can then use this existing connection instead of spinning up a new one.

Step 1: Declare a Global Connection #

At the very top of your VBA module (before any subs/functions), add:

Public cn As ADODB.Connection

Step 2: Create a Reusable Connection Initializer #

Replace your existing connection sub with one that checks if the connection already exists (or is closed) before creating a new one:

Sub InitConnection()
    ' Check if connection is uninitialized or closed
    If cn Is Nothing Then
        Set cn = New ADODB.Connection
        With cn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
            "Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
            .Open
        End With
    ElseIf cn.State = adStateClosed Then
        cn.Open ' Reopen if it was closed
    End If
End Sub

Step 3: Update Your Query Function #

Modify Get_Coeff_1_crit to use the global connection instead of calling connection() every time:

Function Get_Coeff_1_crit(couv As String, tabelle As String, edit As String, crit1 As String) As Variant
    Dim texte_SQL As String
    Dim rst As ADODB.Recordset
    Dim strRangeAddress As String
    
    ' Initialize connection once (not every call)
    Call InitConnection
    
    strRangeAddress = getAddres(edit)
    texte_SQL = "SELECT [Coeff] FROM " & strRangeAddress & " WHERE ([Tabelle]=" & Chr(34) & tabelle & Chr(34) & _
    " ) AND (( [Booléen_1] = " & crit1 & " ) OR ( [Fixe_1] = " & crit1 & " ) OR (" & crit1 & " BETWEEN [Min_1] AND [Max_1] ))"
    
    Set rst = cn.Execute(texte_SQL)
    
    On Error Resume Next
    Get_Coeff_1_crit = 0
    Get_Coeff_1_crit = rst.Fields(0).Value
    
    rst.Close
    Set rst = Nothing
End Function

Even better—load your target table into memory once (like a Python DataFrame) and query it directly from there, avoiding any repeated trips to the Excel file via SQL. This is way faster for bulk queries.

Option A: Use an In-Memory ADODB Recordset #

Declare a global Recordset to hold your table data, load it once, then use Find to query it:

Public rsEditData As ADODB.Recordset

Sub LoadEditDataToMemory()
    InitConnection ' Ensure we have a connection first
    Dim strRangeAddress As String
    strRangeAddress = getAddres("edit") ' Replace with your table name
    
    ' Load entire table into memory
    Set rsEditData = cn.Execute("SELECT * FROM " & strRangeAddress)
End Sub

Function Get_Coeff_1_crit(couv As String, tabelle As String, edit As String, crit1 As String) As Variant
    ' Load data if it's not already in memory
    If rsEditData Is Nothing Then LoadEditDataToMemory
    
    ' Reset recordset position
    rsEditData.MoveFirst
    
    ' Use Find to locate matching rows (adjust the filter to match your needs)
    rsEditData.Find "[Tabelle] = '" & tabelle & "' AND ([Booléen_1] = " & crit1 & " OR [Fixe_1] = " & crit1 & " OR " & crit1 & " BETWEEN [Min_1] AND [Max_1])"
    
    ' Return result or 0 if no match
    If Not rsEditData.EOF Then
        Get_Coeff_1_crit = rsEditData.Fields("Coeff").Value
    Else
        Get_Coeff_1_crit = 0
    End If
End Function

Option B: Use a VBA Array (Even Faster) #

VBA arrays are pure memory structures and can be even faster than Recordsets for simple lookups. Load your table into a 2D array once, then loop through it to find matches:

Public editData As Variant

Sub LoadEditDataToArray()
    Dim tbl As ListObject
    ' Replace with your table's worksheet and name
    Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("edit")
    
    ' Load table data into a 2D array
    editData = tbl.DataBodyRange.Value
End Sub

Function Get_Coeff_1_crit(couv As String, tabelle As String, edit As String, crit1 As String) As Variant
    Dim i As Long
    Get_Coeff_1_crit = 0
    
    ' Load array if it's empty
    If IsEmpty(editData) Then LoadEditDataToArray
    
    ' Loop through the array (adjust column indexes to match your table)
    ' Example: Tabelle = column 2, Booléen_1 = 3, Fixe_1 =4, Min_1=5, Max_1=6, Coeff=7
    For i = LBound(editData, 1) To UBound(editData, 1)
        If editData(i, 2) = tabelle Then
            If (editData(i, 3) = crit1) Or (editData(i, 4) = crit1) Or (crit1 >= editData(i, 5) And crit1 <= editData(i, 6)) Then
                Get_Coeff_1_crit = editData(i, 7)
                Exit For ' Exit loop once first match is found
            End If
        End If
    Next i
End Function

• Initialize on Workbook Open: Add InitConnection and LoadEditDataToMemory/LoadEditDataToArray to your ThisWorkbook module's Workbook_Open event so data is loaded automatically when you open the file.
• Refresh Data: If your source table updates, call the load sub again to refresh the memory data.
• Cleanup: Add a Workbook_BeforeClose event to close the global connection and clear memory objects:

  Private Sub Workbook_BeforeClose(Cancel As Boolean)
      If Not cn Is Nothing Then
          If cn.State = adStateOpen Then cn.Close
          Set cn = Nothing
      End If
      If Not rsEditData Is Nothing Then
          rsEditData.Close
          Set rsEditData = Nothing
      End If
      Erase editData
  End Sub
  

These changes will drastically cut down on query time, especially when running hundreds or thousands of price lookups.

内容的提问来源于stack exchange，提问作者Daniel