VBA暴风操作！批量合并/拆分文件+数据清洗+自动化模板

还在手动处理几百个Excel文件？😱VBA一键批量合并、拆分、清洗数据！本文从零教你用代码实现「多文件合并→智能拆分→数据清洗→自动化模板生成」，附赠财务/人事/物流三大行业模板库，直接套用！📁🧹文末领代码+模板包，告别加班！

---

一、文件处理：批量合并、拆分与格式转换

1. 批量合并文件：跨文件夹自动整合

• 痛点：手动打开多个文件复制粘贴，耗时且易漏数据。
• 解决方案：
  1. 遍历文件夹：用FileSystemObject（FSO）获取所有Excel文件路径。
  2. 动态读取数据：根据文件结构（如固定表名、固定列）自动合并。
  • 代码示例：

    vba

    	Sub MergeExcelFiles()
    	Dim fso As Object, folder As Object, file As Object
    	Dim wbSource As Workbook, wsSource As Worksheet
    	Dim wbDest As Workbook, wsDest As Worksheet
    	Dim lastRow As Long, destLastRow As Long
    	Set fso = CreateObject("Scripting.FileSystemObject")
    	Set folder = fso.GetFolder("C:\数据源文件夹") ' 修改为实际路径
    	Set wbDest = ThisWorkbook ' 当前工作簿作为目标
    	Set wsDest = wbDest.Sheets("合并结果") ' 目标工作表
    	destLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1
    	For Each file In folder.Files
    	If Right(file.Name, 5) = ".xlsx" Or Right(file.Name, 4) = ".xls" Then
    	Set wbSource = Workbooks.Open(file.Path)
    	Set wsSource = wbSource.Sheets(1) ' 假设数据在第一个工作表
    	' 动态获取源数据范围（避免空行）
    	lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    	If lastRow > 1 Then ' 跳过标题行（假设第一行是标题）
    	wsSource.Range("A2:Z" & lastRow).Copy wsDest.Cells(destLastRow, 1)
    	destLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row + 1
    	End If
    	wbSource.Close False ' 关闭源文件，不保存
    	End If
    	Next file
    	MsgBox "合并完成！共处理 " & folder.Files.Count & " 个文件。"
    	End Sub

  • 扩展功能：
    • 按文件名分类：根据文件名中的关键词（如“部门A”“部门B”）拆分到不同工作表。
    • 格式统一：合并后自动调整列宽、字体、边框等格式。

2. 智能拆分文件：按部门/日期自动分表

• 场景：需将合并后的数据按部门或日期拆分为独立文件。
• 实现方法：
  1. 数据分组：用Dictionary对象按部门/日期分类数据。
  2. 动态创建文件：为每个分类创建新工作簿并保存。
  • 代码示例：

    vba

    	Sub SplitDataByDepartment()
    	Dim ws As Worksheet, dict As Object, key As Variant
    	Dim wbNew As Workbook, wsNew As Worksheet
    	Dim lastRow As Long, i As Long, destRow As Long
    	Dim savePath As String
    	Set ws = ThisWorkbook.Sheets("合并结果")
    	Set dict = CreateObject("Scripting.Dictionary")
    	savePath = "C:\拆分结果\" ' 修改为实际路径
    	' 1. 收集所有部门名称
    </