如何在VBA中直接使用WorkbookQuery数据，无需加载至工作表？

你之前找到的代码都是把Power Query结果往工作表里塞，但如果想直接在VBA里抓数据、处理过滤逻辑，或者提取某列的唯一值，完全不用绕工作表这一步——用ADODB直接连Power Query的数据源就搞定了，还能保留原始查询随时重新调用，效率拉满。

第一步：先准备好引用 #

在VBA编辑器里，点「工具」→「引用」，找到并勾选 Microsoft ActiveX Data Objects 6.1 Library（选你能找到的最高版本就行，没有6.1的话，6.0或2.8也能用）。

完整代码示例 #

' 从指定Power Query查询中获取数据，返回ADODB记录集（直接在内存里，不碰工作表）
Function GetPowerQueryData(queryName As String) As ADODB.Recordset
    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim connStr As String
    
    ' 构建连接Power Query数据源的字符串
    connStr = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName
    
    Set conn = New ADODB.Connection
    conn.Open connStr
    
    ' 这里的SQL可以直接加过滤条件，比后续再过滤高效得多
    Set rs = New ADODB.Recordset
    rs.Open "SELECT * FROM [" & queryName & "]", conn, adOpenStatic, adLockReadOnly
    
    Set GetPowerQueryData = rs
    ' 注意：这里别关连接和记录集，等调用方处理完再关
End Function

' 从记录集中提取指定列的所有唯一值，返回一个集合
Function GetUniqueValuesFromColumn(rs As ADODB.Recordset, columnName As String) As Collection
    Dim uniqueCol As New Collection
    Dim cellValue As Variant
    
    On Error Resume Next ' 重复值添加时会报错，直接忽略
    rs.MoveFirst
    Do Until rs.EOF
        cellValue = rs.Fields(columnName).Value
        ' 可选：跳过空值，根据你的需求调整
        If Not IsEmpty(cellValue) Then
            uniqueCol.Add cellValue, Key:=CStr(cellValue)
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0 ' 恢复错误捕获
    
    Set GetUniqueValuesFromColumn = uniqueCol
End Function

' 示例：调用上面的函数处理数据
Sub ProcessPQData()
    Dim pqRecordset As ADODB.Recordset
    Dim uniqueVals As Collection
    Dim item As Variant
    
    ' 替换成你自己的Power Query查询名称
    Set pqRecordset = GetPowerQueryData("你的查询名称")
    
    ' --- 选项1：过滤数据（推荐在SQL里做，效率更高）
    ' 比如要筛选"订单状态"为"已完成"的记录，修改GetPowerQueryData里的SQL：
    ' rs.Open "SELECT * FROM [" & queryName & "] WHERE 订单状态 = '已完成'", conn, adOpenStatic, adLockReadOnly
    ' 也可以在记录集里动态过滤：
    ' pqRecordset.Filter = "订单状态 = '已完成'"
    
    ' --- 选项2：提取指定列的唯一值
    Set uniqueVals = GetUniqueValuesFromColumn(pqRecordset, "产品类别")
    
    ' 把唯一值打印到即时窗口（测试用，你可以改成自己的业务逻辑）
    Debug.Print "=== 唯一产品类别 ==="
    For Each item In uniqueVals
        Debug.Print item
    Next
    
    ' 处理完一定要清理资源，避免内存泄漏
    pqRecordset.Close
    pqRecordset.ActiveConnection.Close
    Set pqRecordset = Nothing
    Set uniqueVals = Nothing
End Sub

关键细节说明 #

1. 为什么用ADODB？
   直接和Power Query的Mashup引擎交互，数据全程在内存里流转，完全不用写入工作表，速度快还不产生临时数据。而且原始查询不动，随时可以重新调用获取最新数据。

2. 过滤数据的两种方式

   • 数据源端过滤（推荐）：在rs.Open的SQL语句里加WHERE条件，让Power Query先把符合条件的数据筛出来再返回，大数据量下效率差很多。
   • 客户端过滤：用Recordset.Filter属性，适合需要在VBA里动态调整过滤条件的场景。

3. 提取唯一值的逻辑
   利用VBA Collection的「Key不能重复」特性，添加值的时候用值本身作为Key，重复添加会报错，用On Error Resume Next跳过错误，最后得到的就是去重后的集合。

4. 资源清理
   处理完数据后一定要关闭记录集和连接，不然会占用内存，甚至导致Excel卡顿。

可选：后期绑定（不用加引用） #

如果怕用户的Excel没有对应的ADODB库，可以改成后期绑定，把所有ADODB.Connection、ADODB.Recordset换成Object，常量换成对应的数值：

' 后期绑定版本的GetPowerQueryData
Function GetPowerQueryData_LateBind(queryName As String) As Object
    Dim conn As Object
    Dim rs As Object
    Dim connStr As String
    
    connStr = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName
    
    Set conn = CreateObject("ADODB.Connection")
    conn.Open connStr
    
    Set rs = CreateObject("ADODB.Recordset")
    ' adOpenStatic = 3, adLockReadOnly = 1
    rs.Open "SELECT * FROM [" & queryName & "]", conn, 3, 1
    
    Set GetPowerQueryData_LateBind = rs
End Function

内容的提问来源于stack exchange，提问作者S. Melted