如何整合VBA代码批量处理多Excel文件并汇总数据生成数据透视表

需求说明 #

需要整合最多12个不同Excel文件的数据，生成统一格式的数据源用于制作数据透视表，单文件格式化后的数据结构如下：

| Company  | Model  | Indicator  | Value |  
| Audi     | A1     | AWD        | 2000  |  
| Mercedes | AMG GT | AWD        | 2500  |  
| ...      | ...    | ...        | ...   |

注：提问者提到此前未成功应用GitHub风格Markdown格式

具体流程要求 #

• 打开存储原始数据的目标文件；
• 使用已有格式化代码处理打开的文件；
• 将格式化后的数据复制到运行宏的文件A_11.xlsm的指定工作表中；
• 批量处理所有选中文件，新数据追加到汇总表现有数据下方，不覆盖原有内容。

现有代码基础 #

已实现批量选择文件、打开文件的VBA框架，以及单文件格式化过程Formatierung_original_Dateien()，现有代码片段如下：

Sub SelectFiles()

Dim varDateipfade As Variant
Dim intcount As Integer
Dim intAnzahlDateien As Integer

varDateipfade = Application.GetOpenFilename("Datei, *.xls", , "Pkw Dateien ausw�hlen", , True)
intAnzahlDateien = UBound(varDateipfade)
MsgBox intAnzahlDateien
For intcount = 1 To intAnzahlDateien
    DatenAuslesen varDateipfade(intcount)
Next

End Sub


Sub DatenAuslesen(varDateipfad As Variant)
Workbooks.Open (varDateipfad)
End Sub

实现代码 #

直接在原有代码框架上补充逻辑即可，完整可运行代码如下：

' 定义全局对象，避免重复引用
Dim wbMain As Workbook
Dim wsSummary As Worksheet

Sub SelectFiles()
    Dim varDateipfade As Variant
    Dim intcount As Integer
    Dim intAnzahlDateien As Integer
    
    ' 初始化主文件与汇总表，请将工作表名修改为你实际存放汇总数据的表名
    Set wbMain = ThisWorkbook
    Set wsSummary = wbMain.Worksheets("PivotSource")
    
    ' 修复原代码选择文件的乱码问题，兼容xls/xlsx/xlsm格式
    varDateipfade = Application.GetOpenFilename("Excel文件, *.xls;*.xlsx;*.xlsm", , "选择需要汇总的原始文件", , True)
    ' 处理用户点击取消的场景
    If Not IsArray(varDateipfade) Then
        MsgBox "未选择任何文件，程序退出"
        Exit Sub
    End If
    
    intAnzahlDateien = UBound(varDateipfade)
    Application.ScreenUpdating = False ' 关闭屏幕更新，提升处理速度
    ' 第一个文件处理时保留表头，后续文件跳过表头避免重复
    For intcount = 1 To intAnzahlDateien
        Call DatenAuslesen(varDateipfade(intcount), (intcount = 1))
    Next
    Application.ScreenUpdating = True
    MsgBox "汇总完成，共处理 " & intAnzahlDateien & " 个文件"
End Sub


Sub DatenAuslesen(varDateipfad As Variant, isFirstFile As Boolean)
    Dim wbSource As Workbook
    Dim wsFormatted As Worksheet
    Dim lastRowSource As Long
    Dim lastRowSummary As Long
    Dim copyRange As Range
    
    ' 打开选中的原始文件
    Set wbSource = Workbooks.Open(varDateipfad)
    ' 调用已有的格式化过程处理当前打开的文件
    Call Formatierung_original_Dateien
    
    ' 假设格式化后的数据存于源文件第一个工作表，若位置不同请自行修改
    Set wsFormatted = wbSource.Worksheets(1)
    ' 定位源文件格式化后数据的最后一行
    lastRowSource = wsFormatted.Cells(wsFormatted.Rows.Count, "A").End(xlUp).Row
    
    ' 确定复制范围：首文件带表头，后续文件仅复制数据行
    If isFirstFile Then
        ' 数据共4列，若实际列数不同请修改列标"D"为对应列
        Set copyRange = wsFormatted.Range("A1:D" & lastRowSource)
    Else
        Set copyRange = wsFormatted.Range("A2:D" & lastRowSource)
    End If
    
    ' 定位汇总表粘贴起始位置
    lastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1
    ' 仅粘贴值，避免带入原文件格式、公式
    copyRange.Copy
    wsSummary.Range("A" & lastRowSummary).PasteSpecial Paste:=xlPasteValues
    
    ' 关闭原始文件，不保存修改
    wbSource.Close SaveChanges:=False
    Application.CutCopyMode = False
End Sub


Sub Formatierung_original_Dateien()
    ' 原有格式化代码保持不变即可
    'The formatting, that deletes, creates and moves the cells.
End Sub

注意事项 #

• 代码中3处需要根据实际场景调整的位置都加了注释：汇总工作表名称、格式化后数据所在的源文件工作表、数据总列数，修改后即可直接运行。
• 所有原始文件处理完成后会自动关闭，不会残留打开的窗口，也不会修改原始文件内容。
• 汇总后的数据为纯值格式，没有多余格式和公式，可直接作为数据透视表的数据源使用。
• 如果格式化过程Formatierung_original_Dateien不是默认对当前激活工作表操作，只需要在调用时传入对应工作表参数即可，核心逻辑不需要调整。

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