如何通过VBA将Power Query嵌套表导出到指定名称的Excel工作表

该需求可以通过VBA实现，整体逻辑为读取Power Query转换后的结果，逐行提取嵌套表内容，创建对应名称的工作表写入数据即可。

前置操作 #

• 确认Power Query中完成转换的查询（包含WorksheetName和Records两列）的名称，建议先将该查询设置为仅创建连接
• 给工作表上的触发按钮绑定后续编写的VBA宏

参考VBA代码 #

Sub 导出PQ嵌套表到分表()
    Dim pqTbl As ListObject
    Dim i As Long
    Dim targetWs As Worksheet
    Dim nestedArr As Variant
    
    ' 兼容性方案：先将PQ查询加载到隐藏工作表"临时_PQ结果"的表中，此处读取该表
    Set pqTbl = ThisWorkbook.Worksheets("临时_PQ结果").ListObjects("PQ结果表")
    
    ' 关闭屏幕更新和提示提升运行效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For i = 1 To pqTbl.ListRows.Count
        ' 可选：删除已存在的同名工作表，不需要可删除本段
        On Error Resume Next
        ThisWorkbook.Sheets(pqTbl.ListColumns("WorksheetName").DataBodyRange(i).Value).Delete
        On Error GoTo 0
        
        ' 创建新工作表并命名
        Set targetWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetWs.Name = pqTbl.ListColumns("WorksheetName").DataBodyRange(i).Value
        
        ' 写入嵌套表数据
        nestedArr = pqTbl.ListColumns("Records").DataBodyRange(i).Value
        targetWs.Range("A1").Resize(UBound(nestedArr, 1), UBound(nestedArr, 2)).Value = nestedArr
        ' 自动调整列宽
        targetWs.UsedRange.EntireColumn.AutoFit
    Next i
    
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "数据导出完成"
End Sub

调整说明 #

• 如果你使用的Excel版本支持直接读取查询结果，可跳过创建临时隐藏表的步骤，直接用ThisWorkbook.Queries("你的查询名").Fold方法获取结果
• 如果不需要每次运行覆盖旧表，删除对应删除工作表的代码段即可
• 运行前将代码里的工作表名、表名替换为你实际的名称即可

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