为何我的VBA与SQL中的SQL查询运行缓慢？

问题描述 #

使用VBA连接SQL数据库执行查询时，功能正常但速度极慢（通常需1分钟以上才能获取数据）。代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim userInput As String
    Dim conn As Object
    Dim rs As Object
    Dim strSQL As String
    Dim cell As Range

    Set cell = Sheet1.Range("H19:I19")

    Application.ScreenUpdating = False

    If Not Intersect(Target, cell) Is Nothing Then
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
    
    If cell.Cells(1, 1).value <> "" Then ' Verifica a célula para procurar por um valor
        If Not IsValidFormat(cell.Cells(1, 1).value) Then
            Application.EnableEvents = True ' Re-enable events before showing the message box
            MsgBox "Formato de texto errado!                                                                    Por favor use uma letra e até 3 números (e.x., X111).", vbExclamation, "Erro: Formato de texto errado"
            UnmergeAndClear cell ' Faz o split e limpa os conteúdos
            Exit Sub
        End If
    End If
    
    Application.EnableEvents = True ' Liga os eventos do excel outra vez
End If
      
If Not Target Is Nothing And Not Intersect(Target, Me.Range("I5")) Is Nothing Then
    If Target.value <> "" Then
    userInput = Target.value
    

    ' Faz a ligação com a base de dados
    Set conn = CreateObject("ADODB.Connection")
    conn.ConnectionTimeout = 0
    conn.CommandTimeout = 0
    conn.Open "Provider=SQLOLEDB;Data Source=IP;Initial Catalog=DB;User ID=.;Password=PASSWORD;"
      
      
    ' Query do valor da fuga,pressão do hélio e data de produção da peça
    strSQL = "SELECT MOTOR_HOUSING_LABEL, REAR_HEAD_LABEL FROM dbo.LineA WHERE PROCESS_LABEL = '" & userInput & "' ORDER BY TIME_STAMP DESC;"
    
    Debug.Print "Executing SQL Query: " & strSQL
    Set rs = conn.Execute(strSQL)
    
    If Not rs.EOF Then
        
        Dim motor As Variant
        Dim rear As Variant

        motor = rs.Fields("MOTOR_HOUSING_LABEL").value
        rear = rs.Fields("REAR_HEAD_LABEL").value
        
        Debug.Print "Motor encontrado na base de dados : " & motor
        Debug.Print "Rear encontrado na base de dados : " & rear
        
        ThisWorkbook.Sheets("Sheet1").Range("K5").value = motor
        ThisWorkbook.Sheets("Sheet1").Range("M5").value = rear
        
    Else
        Debug.Print "Não existe qualquer match na base de dados."
    End If
    
    strSQL = "SELECT ST300_TORQUE, ST400_LEAK_VALUE, ST390_HEPRESS_TEST FROM dbo.LineB WHERE PROCESS_LABEL = '" & userInput & "' ORDER BY TIME_STAMP DESC;"
    
    Debug.Print "Executing SQL Query: " & strSQL
    Set rs = conn.Execute(strSQL)
    
    countSQL = "SELECT COUNT(ST400_LEAK_VALUE) AS LeakCount FROM dbo.LineB WHERE PROCESS_LABEL = '" & userInput & "' AND ST400_LEAK_VALUE IS NOT NULL ;"
    Set countRS = conn.Execute(countSQL)
    
    If Not rs.EOF Then
        Dim torqueparafusos As Variant
        Dim leakvalue As Variant
        Dim heliumpress As Variant
    
        heliumpress = rs.Fields("ST390_HEPRESS_TEST").value
        torqueparafusos = rs.Fields("ST300_TORQUE").value
        leakvalue = rs.Fields("ST400_LEAK_VALUE").value

        Debug.Print "Valor de fuga encontrado na base de dados : " & leakvalue
        Debug.Print "Torque encontrado na base de dados : " & torqueparafusos
        Debug.Print "Valor da pressão do hélio encontrada na base de dados : "

        ThisWorkbook.Sheets("Sheet1").Range("T10").value = torqueparafusos
        ThisWorkbook.Sheets("Sheet1").Range("S10").value = leakvalue
        ThisWorkbook.Sheets("Sheet1").Range("U10").value = heliumpress
    
        Dim leakCount As Long
        leakCount = countRS.Fields("LeakCount").value
        ThisWorkbook.Sheets("Sheet1").Range("R10").value = leakCount
    
   Else
       Debug.Print "Não existe qualquer match na base de dados."
   End If
  
   rs.Close
   conn.Close
   Set rs = Nothing
   Set conn = Nothing
End If
End If
End Sub

注：我是SQL新手，不清楚问题所在。另有一个工作簿使用类似查询仅需2-3秒，但该工作簿查询的表数据量远小于当前表，我认为这不应该导致如此大的耗时差异，恳请指点或提供解决方向。

优化方案 #

1. 给数据库表添加针对性索引 #

你的查询核心是通过PROCESS_LABEL过滤数据，并按TIME_STAMP倒序取最新记录，全表扫描是慢查询的主要原因。给两个表创建包含必要字段的非聚集索引：

针对LineA表：

CREATE NONCLUSTERED INDEX IX_LineA_ProcessLabel 
ON dbo.LineA (PROCESS_LABEL, TIME_STAMP DESC)
INCLUDE (MOTOR_HOUSING_LABEL, REAR_HEAD_LABEL);

针对LineB表：

CREATE NONCLUSTERED INDEX IX_LineB_ProcessLabel 
ON dbo.LineB (PROCESS_LABEL, TIME_STAMP DESC)
INCLUDE (ST300_TORQUE, ST400_LEAK_VALUE, ST390_HEPRESS_TEST);

索引会让数据库直接定位到目标数据，避免全表扫描，这是提升查询速度最有效的手段。

2. 合并查询减少数据库交互 #

当前代码执行了3次独立查询（LineA一次、LineB一次、计数一次），多次往返数据库会增加耗时。将LineB的查询和计数合并为一次：

修改VBA中的SQL语句：

SELECT TOP 1 
    ST300_TORQUE, 
    ST400_LEAK_VALUE, 
    ST390_HEPRESS_TEST,
    (SELECT COUNT(ST400_LEAK_VALUE) 
     FROM dbo.LineB 
     WHERE PROCESS_LABEL = '" & userInput & "' AND ST400_LEAK_VALUE IS NOT NULL) AS LeakCount
FROM dbo.LineB 
WHERE PROCESS_LABEL = '" & userInput & "' 
ORDER BY TIME_STAMP DESC;

这样一次查询就能拿到所有需要的数据，减少连接开销。

3. 修复VBA代码的潜在问题 #

• 设置合理超时时间：当前conn.ConnectionTimeout = 0和conn.CommandTimeout = 0会导致无限等待，建议设置为合理值，比如conn.CommandTimeout = 30（30秒），避免无意义的等待。
• 声明变量类型：countSQL和countRS未声明类型，添加Dim countSQL As String和Dim countRS As Object，避免变体类型的性能损耗。
• 关闭所有记录集：当前只关闭了rs，需要添加countRS.Close和Set countRS = Nothing，释放资源。

4. 使用参数化查询避免SQL注入并提升性能 #

直接拼接userInput到SQL语句中，不仅有SQL注入风险，还会让数据库无法缓存查询计划。改用参数化查询：

示例代码（替换LineA的查询部分）：

strSQL = "SELECT MOTOR_HOUSING_LABEL, REAR_HEAD_LABEL FROM dbo.LineA WHERE PROCESS_LABEL = ? ORDER BY TIME_STAMP DESC;"
Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = conn
cmd.CommandText = strSQL
' 根据PROCESS_LABEL字段的实际长度调整参数长度（这里设为50）
cmd.Parameters.Append cmd.CreateParameter("@ProcessLabel", 200, 1, 50, userInput) ' adVarChar=200, adParamInput=1
Set rs = cmd.Execute()

参数化查询能让数据库缓存执行计划，重复查询时速度更快，同时避免安全风险。

内容的提问来源于stack exchange，提问作者Gonçalo