使用Excel VBA ADODB Recordset获取前置值时查询速度过慢问题

Access中查询快是因为tblData表可针对UnitNo和ShamsiDate创建索引，子查询能通过索引快速定位匹配数据；而Excel的OLEDB驱动无法对工作表[Data$]创建有效索引，子查询会对每一行执行全表扫描，数据量较大时直接导致性能爆炸，耗时剧增。

以下是三种可行的优化方案，按推荐优先级排序：

方案1：用Power Query处理（最简便，无复杂代码） #

Power Query对分组排序类操作的优化远优于Excel OLEDB，能高效计算分组前序最大值：

1. 选中[Data$]数据区域，点击数据>从表格/范围，导入Power Query编辑器
2. 按UnitNo和ShamsiDate升序排序（确保日期顺序正确）
3. 添加自定义列，用更高效的写法（利用排序后的顺序，避免重复扫描）：

   let
       currentUnit = [UnitNo],
       currentDate = [ShamsiDate],
       filteredRows = Table.SelectRows(#"Sorted Rows", (x) => x[UnitNo] = currentUnit and x[ShamsiDate] < currentDate),
       priorValues = filteredRows[Counter_MVH+]
   in
       if List.Count(priorValues) = 0 then null else List.Max(priorValues)
   

4. 点击关闭并上载，将结果导入新工作表，速度会比原方法快几个数量级。

方案2：VBA内存数组+字典处理（纯Excel环境，性能优异） #

跳过OLEDB查询，直接在内存中处理数据，避免磁盘IO和全表扫描：

Sub CalculatePriorValue()
    Dim srcData As Variant, resultData As Variant
    Dim i As Long, j As Long
    Dim unitDict As Object
    
    ' 读取源数据到数组（内存操作）
    srcData = Sheet1.Range("A1").CurrentRegion.Value
    ReDim resultData(1 To UBound(srcData, 1), 1 To UBound(srcData, 2) + 1)
    
    ' 复制原数据到结果数组
    For i = 1 To UBound(srcData, 1)
        For j = 1 To UBound(srcData, 2)
            resultData(i, j) = srcData(i, j)
        Next j
    Next i
    resultData(1, 4) = "PriorValue" ' 写入新表头
    
    ' 按UnitNo和ShamsiDate排序数组（主关键字UnitNo，次关键字日期）
    Call Sort2DArray(srcData, 2, 1)
    
    ' 用字典记录每个UnitNo的最新Counter最大值
    Set unitDict = CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(srcData, 1) ' 跳过表头
        Dim currentUnit As String
        currentUnit = srcData(i, 2)
        If unitDict.Exists(currentUnit) Then
            resultData(i, 4) = unitDict(currentUnit)
            ' 更新最大值（如果当前Counter更大）
            If srcData(i, 3) > unitDict(currentUnit) Then
                unitDict(currentUnit) = srcData(i, 3)
            End If
        Else
            resultData(i, 4) = Null
            unitDict(currentUnit) = srcData(i, 3)
        End If
    Next i
    
    ' 将结果写入Sheet2
    Sheet2.Range("A1").Resize(UBound(resultData, 1), UBound(resultData, 2)).Value = resultData
End Sub

' 辅助函数：二维数组按两列排序
Sub Sort2DArray(arr As Variant, keyCol1 As Long, keyCol2 As Long)
    Dim i As Long, j As Long, temp As Variant
    For i = LBound(arr, 1) To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            If arr(i, keyCol1) > arr(j, keyCol1) Or _
               (arr(i, keyCol1) = arr(j, keyCol1) And arr(i, keyCol2) > arr(j, keyCol2)) Then
                ' 交换整行数据
                temp = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = temp
                temp = arr(i, 2): arr(i, 2) = arr(j, 2): arr(j, 2) = temp
                temp = arr(i, 3): arr(i, 3) = arr(j, 3): arr(j, 3) = temp
            End If
        Next j
    Next i
End Sub

这个方法通过内存数组+字典实现，避免了OLEDB的低效查询，数据量越大优势越明显。

方案3：借助Access临时表复用原查询逻辑 #

如果必须保留原Access查询的逻辑，可以将Excel数据导入Access临时表，利用Access的索引优化：

Sub UseAccessForQuery()
    Dim cn As Object, rs As Object
    Dim accessPath As String
    
    ' 临时Access数据库路径（可自定义）
    accessPath = Environ("TEMP") & "\TempDB.accdb"
    
    ' 创建并连接临时Access数据库
    Set cn = CreateObject("ADODB.Connection")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & accessPath & ";Jet OLEDB:Engine Type=5;"
    
    ' 创建临时表并导入Excel数据
    cn.Execute "CREATE TABLE tblData (ShamsiDate TEXT, UnitNo TEXT, [Counter_MVH+] DOUBLE)"
    cn.Execute "INSERT INTO tblData SELECT * FROM [Excel 12.0 Xml;HDR=YES;Database=" & ThisWorkbook.FullName & "].[Data$]"
    
    ' 创建索引（关键！提升子查询速度）
    cn.Execute "CREATE INDEX idx_UnitDate ON tblData (UnitNo, ShamsiDate)"
    
    ' 执行原查询
    Set rs = cn.Execute("SELECT d.ShamsiDate, d.UnitNo, d.[Counter_MVH+], " & _
                        "(SELECT MAX(d1.[Counter_MVH+]) FROM tblData AS d1 " & _
                        "WHERE d1.UnitNo = d.UnitNo AND d1.ShamsiDate < d.ShamsiDate) AS PriorValue " & _
                        "FROM tblData d")
    
    ' 导出结果到Excel
    Sheet2.Range("A2").CopyFromRecordset rs
    
    ' 清理资源
    rs.Close
    cn.Execute "DROP TABLE tblData"
    cn.Close
    Kill accessPath ' 删除临时数据库
End Sub

此方法利用Access的索引优化原查询逻辑，执行速度会和Access中一致。

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