如何用VBA自动化PowerQuery从同数据源生成多表并适配列变动

一、重构PowerQuery的M代码（动态适配列变化） #

核心思路是移除所有硬编码的列配置，让PowerQuery自动识别数据源结构，仅针对固定存在的关键列做筛选：

let
    // 读取CSV文件，不硬编码列数，自动检测分隔符与列结构
    Source = Csv.Document(File.Contents(FilePath), [Delimiter=",", Encoding=1252, QuoteStyle=QuoteStyle.None]),
    // 自动提升表头（不受列顺序变动影响）
    #"Promoted Headers" = Table.PromoteHeaders(Source, [PromoteAllScalars=true]),
    // 自动检测列类型（替代硬编码的类型转换，适配新增/删除的列）
    #"Auto Detected Types" = Table.AutoDetectColumnTypes(#"Promoted Headers", [Culture="en-US"]),
    // 根据固定关键列名筛选发票（关键列始终存在，用列名而非位置）
    #"Filtered Rows" = Table.SelectRows(#"Auto Detected Types", each ([发票编号列名] = TargetInvoiceNumber))
in
    #"Filtered Rows"

替换说明：将发票编号列名改为你实际的关键列名称（比如"InvoiceRef"），FilePath和TargetInvoiceNumber会由VBA动态传入。

二、优化VBA代码：动态生成查询并复用逻辑 #

取消对固定QueryFormula的依赖，直接在VBA中构建动态M代码，同时复用已有查询和工作表，避免冗余操作：

Sub ExtractInvoiceData()
    Dim InvoiceList As Range
    Dim c As Range
    Dim sourcePath As String
    Dim keyColumnName As String
    Dim mCodeTemplate As String
    Dim mCode As String
    Dim newQuery As WorkbookQuery
    Dim newWs As Worksheet
    
    ' 基础配置（可根据需求改为从单元格读取）
    Set InvoiceList = Range("Invoice_Selections[Ref]") ' 发票编号列表
    sourcePath = Sheet1.Range("K2").Value ' 数据源文件路径
    keyColumnName = "InvoiceRef" ' 关键列的固定名称
    
    ' M代码模板，预留占位符供动态替换
    mCodeTemplate = "let" & vbCrLf & _
        "    Source = Csv.Document(File.Contents(""{FilePath}""), [Delimiter="","", Encoding=1252, QuoteStyle=QuoteStyle.None])," & vbCrLf & _
        "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & vbCrLf & _
        "    #""Auto Detected Types"" = Table.AutoDetectColumnTypes(#""Promoted Headers"", [Culture=""en-US""])," & vbCrLf & _
        "    #""Filtered Rows"" = Table.SelectRows(#""Auto Detected Types"", each ([{KeyCol}] = ""{InvoiceNum}""))" & vbCrLf & _
        "in" & vbCrLf & _
        "    #""Filtered Rows"""
    
    Application.ScreenUpdating = False
    
    ' 遍历每个发票编号
    For Each c In InvoiceList
        Dim invoiceNum As String
        invoiceNum = c.Value
        
        ' 替换模板中的占位符
        mCode = Replace(mCodeTemplate, "{FilePath}", sourcePath)
        mCode = Replace(mCode, "{KeyCol}", keyColumnName)
        mCode = Replace(mCode, "{InvoiceNum}", invoiceNum)
        
        ' 检查查询是否已存在，存在则更新，不存在则新建
        On Error Resume Next
        Set newQuery = ActiveWorkbook.Queries(invoiceNum)
        On Error GoTo 0
        
        If newQuery Is Nothing Then
            Set newQuery = ActiveWorkbook.Queries.Add(Name:=invoiceNum, Formula:=mCode)
        Else
            newQuery.Formula = mCode
        End If
        
        ' 检查工作表是否已存在，存在则刷新，不存在则新建并加载数据
        On Error Resume Next
        Set newWs = ThisWorkbook.Worksheets("#" & invoiceNum)
        On Error GoTo 0
        
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            newWs.Name = "#" & invoiceNum
            newWs.ListObjects.Add(SourceType:=0, Source:= _
                "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & invoiceNum _
                , Destination:=newWs.Range("$A$1")).QueryTable.Refresh
        Else
            newWs.ListObjects(1).QueryTable.Refresh
        End If
    Next c
    
    Application.ScreenUpdating = True
End Sub

关键优化点说明 #

• 动态列适配：PowerQuery通过Table.AutoDetectColumnTypes自动识别列类型，无需硬编码列数或类型，完全适配数据源列的新增、删除、移动。
• 资源复用：VBA会检查查询和工作表是否已存在，避免重复创建冗余对象，提升运行效率。
• 配置灵活：关键列名、数据源路径、发票列表均可灵活调整，无需修改核心代码。

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