当然可以搞定！针对Excel 2010搭配Power Query（当时官方叫「Microsoft Power Query for Excel 2010」）的场景，我们完全可以用VBA脚本把这套每月重复的操作自动化，完美适配你提到的内存限制需求。

核心实现思路 #

• 按命名规则自动识别上月的部门预测表格（比如事业部X-YYYYMM格式）
• 批量将这些表格添加到Workbook Queries中
• 自动执行追加合并操作（前提是所有表格列结构一致）
• 自动删除上上月的旧查询连接，仅保留最近2个月数据避免内存溢出

具体VBA实现代码 #

Sub AutoUpdateForecastQueries()
    Dim wb As Workbook
    Dim conn As WorkbookConnection
    Dim qt As QueryTable
    Dim lastMonth As String, twoMonthsAgo As String
    Dim deptPrefixes As Variant
    Dim dept As Variant
    Dim newQueryName As String, oldQueryName As String
    Dim i As Integer
    
    Set wb = ThisWorkbook
    
    ' 获取上月、上上月的年月格式（示例：202406、202405）
    lastMonth = Format(DateAdd("m", -1, Date), "YYYYMM")
    twoMonthsAgo = Format(DateAdd("m", -2, Date), "YYYYMM")
    
    ' 替换成你实际的事业部前缀列表
    deptPrefixes = Array("事业部1", "事业部2", "事业部3", "事业部4", "事业部5", "事业部6")
    
    ' --- 步骤1：批量添加上月的部门预测表格到Workbook Queries ---
    For Each dept In deptPrefixes
        newQueryName = dept & "-" & lastMonth
        
        ' 先检查查询是否已存在，避免重复添加
        On Error Resume Next
        Set conn = wb.Connections(newQueryName)
        On Error GoTo 0
        
        If conn Is Nothing Then
            ' 创建Power Query查询（假设部门表格和汇总表在同一工作簿）
            With wb.Queries.Add(Name:=newQueryName, Formula:= _
                "let" & Chr(13) & "" & Chr(10) & _
                "    Source = Excel.CurrentWorkbook(){[Name=""" & newQueryName & """]}[Content]," & Chr(13) & "" & Chr(10) & _
                "    ChangedType = Table.TransformColumnTypes(Source,{{""日期"", type date}, {""部门"", type text}, {""预测值"", Int64.Type}})" & Chr(13) & "" & Chr(10) & _
                "in" & Chr(13) & "" & Chr(10) & _
                "    ChangedType")
                .Description = dept & " " & lastMonth & " 预测数据"
            End With
            
            ' 通过临时工作表将查询加载为仅连接（无需单独显示表格）
            Application.DisplayAlerts = False
            wb.Worksheets.Add.Name = "Temp_" & newQueryName
            Application.DisplayAlerts = True
            
            Set qt = wb.Worksheets("Temp_" & newQueryName).ListObjects.Add(SourceType:=0, Source:= _
                "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & newQueryName & ";Extended Properties=""""" _
                , Destination:=Range("$A$1")).QueryTable
            With qt
                .CommandType = xlCmdSql
                .CommandText = Array("SELECT * FROM [" & newQueryName & "]")
                .Refresh BackgroundQuery:=False
            End With
            
            ' 删除临时工作表
            Application.DisplayAlerts = False
            wb.Worksheets("Temp_" & newQueryName).Delete
            Application.DisplayAlerts = True
        End If
        Set conn = Nothing
    Next dept
    
    ' --- 步骤2：自动追加合并上月所有部门的查询数据 ---
    Dim mergeQueryFormula As String
    mergeQueryFormula = "let" & Chr(13) & "" & Chr(10) & "    Source = #" & Chr(34) & deptPrefixes(0) & "-" & lastMonth & Chr(34) & "," & Chr(13) & "" & Chr(10)
    
    ' 循环追加其他部门的数据
    For i = 1 To UBound(deptPrefixes)
        mergeQueryFormula = mergeQueryFormula & "    Appended" & i & " = Table.Combine({Source, #" & Chr(34) & deptPrefixes(i) & "-" & lastMonth & Chr(34) & "})," & Chr(13) & "" & Chr(10)
        mergeQueryFormula = mergeQueryFormula & "    Source = Appended" & i & "," & Chr(13) & "" & Chr(10)
    Next i
    
    mergeQueryFormula = mergeQueryFormula & "    FinalTable = Source" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    FinalTable"
    
    ' 更新或创建合并后的汇总查询
    On Error Resume Next
    wb.Queries("预测汇总合并").Delete
    On Error GoTo 0
    With wb.Queries.Add(Name:="预测汇总合并", Formula:=mergeQueryFormula)
        .Description = "上月各部门预测数据合并表"
    End With
    
    ' 将合并数据加载到指定工作表（这里假设工作表名为「汇总表」）
    On Error Resume Next
    wb.Worksheets("汇总表").ListObjects("预测汇总合并").Delete
    On Error GoTo 0
    Set qt = wb.Worksheets("汇总表").ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=预测汇总合并;Extended Properties=""""" _
        , Destination:=wb.Worksheets("汇总表").Range("$A$1")).QueryTable
    With qt
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [预测汇总合并]")
        .Refresh BackgroundQuery:=False
        .ListObject.DisplayName = "预测汇总合并"
    End With
    
    ' --- 步骤3：自动删除上上月的旧查询连接 ---
    For Each dept In deptPrefixes
        oldQueryName = dept & "-" & twoMonthsAgo
        On Error Resume Next
        wb.Queries(oldQueryName).Delete
        Set conn = wb.Connections(oldQueryName)
        If Not conn Is Nothing Then conn.Delete
        On Error GoTo 0
    Next dept
    
    MsgBox "自动化操作完成！已添加上月查询、合并数据并删除上上月旧连接。", vbInformation
End Sub

关键注意事项 #

• 命名规则要严格：所有部门预测表格必须遵循事业部X-YYYYMM的命名格式，脚本才能准确识别目标表格。
• 列结构必须一致：所有部门预测表的列名、数据类型要完全匹配，否则追加合并会报错。
• Excel 2010兼容性：确保已安装「Microsoft Power Query for Excel 2010」，并且在VBA编辑器的「工具→引用」中勾选了Power Query相关的库。
• 先测试再正式用：第一次运行前务必备份工作簿，在测试环境验证脚本逻辑是否符合你的实际需求，尤其是合并和删除步骤。
• 内存优化效果：脚本仅保留最近2个月的查询连接，完美避开了Excel 2010+Power Query的内存限制问题。

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