当前位置：首页 > news >正文

常用 Excel VBA 技巧，简单好学易上手

news 来源：原创 2025/9/17 0:36:56

在日常办公中，我们常常会遇到各种繁琐的数据处理任务，而 Excel VBA（Visual Basic for Applications）作为一款强大的自动化工具，能够帮助我们轻松应对这些挑战。本文将介绍一些常用且简单好学的 Excel VBA 技巧，包括文档的合并与拆分，以及如何使用 Control 配置表进行灵活配置。

在 VBA 代码中，可以通过读取 Control Sheet 中的这些参数来实现灵活配置，通过学习和掌握这些常用的 Excel VBA 技巧，如文档的合并与拆分，以及利用 Control Sheet 进行灵活配置，我们能够显著提高数据处理的效率，轻松应对各种复杂的办公任务。希望本文介绍的内容能够帮助你在日常工作中更好地发挥 Excel VBA 的强大功能。

启用 VBA 编辑器

在开始使用 VBA 之前，需要确保 Excel 中启用了开发工具选项卡。具体步骤如下：

点击 “文件” 选项卡。
选择 “选项”。
在弹出的 “Excel 选项” 对话框中，选择 “自定义功能区”。
在右侧的 “主选项卡” 列表中，勾选 “开发工具”，然后点击 “确定”。
启用开发工具选项卡后，只需按下 “Alt + F11” 组合键，即可快速打开 VBA 编辑器。

case 1

文档拆分

有时我们需要将一个包含多个工作表的 Excel 文件拆分为多个独立的文件。以下是实现这一功能的 VBA 代码：

场景例如将集团的数据按公司代码进行拆分

整体业务目标

该代码的主要业务目标是从一个源 Excel 文件中提取特定数据，按照一定规则进行排序和分组，例如是公司代码，然后将分组后的数据分别保存到多个新的 Excel 文件中，并且对这些新文件进行一些格式设置和保护操作。

具体需求步骤

1. 数据配置获取

代码从当前工作簿（主工作簿）的名为 “control” 的工作表中读取一系列配置信息，这些信息包括：
- 源文件的文件名、所在工作表名和文件夹路径。
- 粘贴数据的工作表名。
- 表头的行数。有时候表头不只一行，可能是组合式的多行表头，拆分的时候要复制表头。
- 保存文件的文件名、工作表名和文件夹路径。

2. 数据准备

清空主工作簿中名为 “raw” 的工作表的所有内容。
打开源文件和指定的工作表，将源工作表中 A 列到 I 列的数据复制到 “raw” 工作表中。

3. 数据排序

对 “raw” 工作表中的数据按照公司代码B 列的值进行升序排序。排序的表头设置为有表头，排序方法为按拼音排序。

4. 数据分组与保存

初始化一些变量，用于跟踪当前处理的数据分组情况，包括上一个值、区域、复制起始行和上一次值变化的行。
遍历 “raw” 工作表中的数据行（从第 2 行到最后一行）：
- 当 B 列的值发生变化或者到达最后一行时：
  - 创建一个新的工作簿，并选择其第一个工作表作为目标工作表。
  - 将 “raw” 工作表的表头（A1 到指定列宽对应的表头行）复制到目标工作表的第一行，同时粘贴格式。
  - 根据当前行和上一次值变化的行，确定要复制的数据行范围，将这些数据行（包括格式）复制到目标工作表的第二行开始的位置。
  - 自动调整目标工作表 A 列到 I 列的列宽。
  - 对目标工作表的 I 列设置可编辑区域，同时对整个工作表进行保护，防止用户修改绘图对象、内容和方案。
  - 在目标工作表的第一行处冻结窗格，方便查看数据。
  - 根据配置信息和当前区域、值生成保存文件的路径和文件名，将新工作簿保存到指定位置，然后关闭该工作簿。
  - 更新上一个值、区域和复制起始行，以便处理下一个分组。

业务场景实例

要拆开的内容

实际的数据要从其他 file 获得

设置 control 配置表

代码说明

变量声明部分

vba

Dim wbMaster As Workbook
Dim wsControl As Worksheet
Dim sourceFileName As String
Dim sourceSheetName As String
Dim sourceFolderPath As String
Dim pasteSheetName As String
Dim headerRows As Long
Dim maxRows As Long
Dim saveFileName As String
Dim saveSheetName As String
Dim saveFolderPath As String
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsRaw As Worksheet
Dim wsTarget As Worksheet
Dim rowCount As Long
Dim pasteRow As Long
Dim lastValueChangeRow As Long
Dim copyRowRange As Range

此部分代码的作用是声明程序里要用到的各类变量，涵盖工作簿对象、工作表对象、字符串变量、长整型变量以及区域对象等。这些变量分别用于存储源文件与目标文件的相关信息、工作表对象、行数、区域范围等内容。

初始化对象与获取配置信息部分

vba

Set wbMaster = ThisWorkbook
Set wsControl = wbMaster.Sheets("control")
Set wsRaw = wbMaster.Sheets("raw")sourceFileName = wsControl.Range("B3").Value
sourceSheetName = wsControl.Range("B4").Value
sourceFolderPath = wsControl.Range("B5").Value
pasteSheetName = wsControl.Range("B8").Value
headerRows = wsControl.Range("B9").Value
maxRows = wsControl.Range("B10").Value
saveFileName = wsControl.Range("B13").Value
saveSheetName = wsControl.Range("B14").Value
saveFolderPath = wsControl.Range("B15").Value
colWidth = wsControl.Range("D9").ValuewsRaw.Select
Cells.Select
Selection.ClearContents

Set wbMaster = ThisWorkbook：把当前正在运行代码的工作簿赋值给 wbMaster。
Set wsControl = wbMaster.Sheets("control") 和 Set wsRaw = wbMaster.Sheets("raw")：分别获取名为 “control” 和 “raw” 的工作表对象。
后续代码从 “control” 工作表的特定单元格里读取配置信息，像源文件名、源工作表名、保存文件名等。
wsRaw.Select、Cells.Select 和 Selection.ClearContents：选中 “raw” 工作表的所有单元格并清空其内容。

打开源工作簿并复制数据部分

vba

Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)
Set wsSource = wbSource.Sheets(sourceSheetName)wsRaw.Range("A:I").Value = wsSource.Range("A:I").ValueendRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).Row

Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)：依据之前获取的源文件路径和文件名打开源工作簿。
Set wsSource = wbSource.Sheets(sourceSheetName)：获取源工作簿里指定名称的工作表对象。
wsRaw.Range("A:I").Value = wsSource.Range("A:I").Value：把源工作表中 A 列到 I 列的数据复制到 “raw” 工作表对应的列。
endRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).Row：找出 “raw” 工作表中 A 列有数据的最后一行。

数据排序部分

vba

wsRaw.Activate
wsRaw.Sort.SortFields.Add2 Key:=Range( _"B2:B26275"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _xlSortNormal
With wsRaw.Sort.SetRange Range("A1:I26275").Header = xlYes.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.Apply
End With

此部分代码对 “raw” 工作表中的数据进行排序。
wsRaw.Sort.SortFields.Add2：添加排序字段，按照 B2 到 B26275 单元格的值进行升序排序。
With wsRaw.Sort 块：设置排序范围为 A1 到 I26275，表明有表头，不区分大小写，排序方向为从上到下，排序方法为按拼音排序，最后应用排序操作。

初始化分组变量部分

vba

lastValue = wsRaw.Cells(headerRows + 1, 2).Value
Region = wsRaw.Cells(headerRows + 1, 1).Value
rowCopyFrom = headerRows + 1
lastValueChangeRow = headerRows + 1

这部分代码对分组操作所需的变量进行初始化。lastValue 存储当前分组的判断值，Region 存储区域信息，rowCopyFrom 记录复制数据的起始行，lastValueChangeRow 记录上一次值发生变化的行。

数据分组与保存部分

vba

For rowCount = 2 To endRowcurrentValue = wsRaw.Cells(rowCount, 2).ValueIf currentValue <> lastValue Or rowCount = endRow ThenlastValueChangeRow = rowCount' 创建新工作簿Set NewWorkbook = Workbooks.AddSet wsTarget = NewWorkbook.Sheets(1)' 复制表头Set copyRowRange = wsRaw.Range("A1:" & colWidth & headerRows)copyRowRange.CopywsTarget.Cells(1, 1).PasteSpecial xlPasteAllApplication.CutCopyMode = False' 复制内容If rowCount = endRow ThenSet copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow)ElseSet copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow - 1)End IfcopyRowRange.CopywsTarget.Cells(2, 1).PasteSpecial xlPasteAllApplication.CutCopyMode = False' 调整列宽wsTarget.Columns("A:I").EntireColumn.AutoFit' 保护工作表wsTarget.Protection.AllowEditRanges.Add Title:="AREA1", Range:=Columns("I:I")wsTarget.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True' 冻结窗格wsTarget.ActivateWith ActiveWindow.SplitColumn = 0.SplitRow = 1End WithActiveWindow.FreezePanes = True' 保存并关闭工作簿savePath = saveFolderPath & "\" & saveFileName & "_" & Region & "_" & lastValue & ".xlsx"NewWorkbook.SaveAs savePathNewWorkbook.Close' 更新变量lastValue = currentValueRegion = wsRaw.Cells(rowCount, 1).ValuerowCopyFrom = rowCountEnd If
Next rowCount

这是一个 For 循环，会遍历 “raw” 工作表中从第 2 行到最后一行的数据。
当 currentValue（当前行第 2 列的值）和 lastValue 不同，或者到达最后一行时，就会进行分组操作：
- 创建一个新的工作簿和工作表对象。
- 复制 “raw” 工作表的表头到新工作簿的工作表中。
- 根据当前行和上一次值变化的行，确定要复制的数据范围并复制到新工作簿的工作表里。
- 自动调整新工作簿工作表中 A 列到 I 列的列宽。
- 对新工作簿的工作表进行保护，允许编辑 I 列。
- 在新工作簿的工作表第一行处冻结窗格。
- 按照指定的规则生成保存路径和文件名，保存新工作簿并关闭。
- 更新 lastValue、Region 和 rowCopyFrom 变量，为下一个分组做准备。

综上所述，这段代码的主要功能是读取源文件的数据，对数据进行排序和分组，然后将分组后的数据分别保存到多个新的工作簿中，同时对这些新工作簿的工作表进行格式设置和保护。

完整代码

Sub CopyData()Dim wbMaster As WorkbookDim wsControl As WorksheetDim sourceFileName As StringDim sourceSheetName As StringDim sourceFolderPath As StringDim pasteSheetName As StringDim headerRows As LongDim maxRows As LongDim saveFileName As StringDim saveSheetName As StringDim saveFolderPath As StringDim wbSource As WorkbookDim wsSource As WorksheetDim wsRaw As WorksheetDim wsTarget As WorksheetDim rowCount As LongDim pasteRow As LongDim lastValueChangeRow As LongDim copyRowRange As RangeSet wbMaster = ThisWorkbookSet wsControl = wbMaster.Sheets("control")Set wsRaw = wbMaster.Sheets("raw")sourceFileName = wsControl.Range("B3").ValuesourceSheetName = wsControl.Range("B4").ValuesourceFolderPath = wsControl.Range("B5").ValuepasteSheetName = wsControl.Range("B8").ValueheaderRows = wsControl.Range("B9").ValuemaxRows = wsControl.Range("B10").ValuesaveFileName = wsControl.Range("B13").ValuesaveSheetName = wsControl.Range("B14").ValuesaveFolderPath = wsControl.Range("B15").ValuecolWidth = wsControl.Range("D9").ValuewsRaw.SelectCells.SelectSelection.ClearContents' 打开源工作簿和工作表Set wbSource = Workbooks.Open(sourceFolderPath & "\" & sourceFileName)Set wsSource = wbSource.Sheets(sourceSheetName)wsRaw.Range("A:I").Value = wsSource.Range("A:I").ValueendRow = wsRaw.Cells(Rows.Count, 1).End(xlUp).RowwsRaw.ActivatewsRaw.Sort.SortFields.Add2 Key:=Range( _"B2:B26275"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _xlSortNormalWith wsRaw.Sort.SetRange Range("A1:I26275").Header = xlYes.MatchCase = False.Orientation = xlTopToBottom.SortMethod = xlPinYin.ApplyEnd With' ?? 初始化变量lastValue = wsRaw.Cells(headerRows + 1, 2).ValueRegion = wsRaw.Cells(headerRows + 1, 1).ValuerowCopyFrom = headerRows + 1lastValueChangeRow = headerRows + 1For rowCount = 2 To endRowcurrentValue = wsRaw.Cells(rowCount, 2).ValueIf currentValue <> lastValue Or rowCount = endRow ThenlastValueChangeRow = rowCount' company code 变化 create new workbookSet NewWorkbook = Workbooks.AddSet wsTarget = NewWorkbook.Sheets(1)'表头Set copyRowRange = wsRaw.Range("A1:" & colWidth & headerRows)' 粘贴到目标工作表copyRowRange.CopywsTarget.Cells(1, 1).PasteSpecial xlPasteAll ' 粘贴所有内容包括格式Application.CutCopyMode = False'内容If rowCount = endRow ThenSet copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow)ElseSet copyRowRange = wsRaw.Range("A" & rowCopyFrom & ":" & colWidth & lastValueChangeRow - 1)End If' 粘贴到目标工作表copyRowRange.CopywsTarget.Cells(2, 1).PasteSpecial xlPasteAll ' 粘贴所有内容包括格式Application.CutCopyMode = FalsewsTarget.Columns("A:I").EntireColumn.AutoFitwsTarget.Protection.AllowEditRanges.Add Title:="AREA1", Range:=Columns("I:I")wsTarget.Protect DrawingObjects:=True, Contents:=True, Scenarios:=TruewsTarget.ActivateWith ActiveWindow.SplitColumn = 0.SplitRow = 1End WithActiveWindow.FreezePanes = TruesavePath = saveFolderPath & "\" & saveFileName & "_" & Region & "_" & lastValue & ".xlsx"NewWorkbook.SaveAs savePathNewWorkbook.Close'update lastvaluelastValue = currentValueRegion = wsRaw.Cells(rowCount, 1).ValuerowCopyFrom = rowCountEnd IfNext rowCountEnd Sub

如何利用 AI 协助写代码

关键：将问题拆开为独立的小问题，不要贪心让AI 给你完整代码，逻辑一定要自己掌握。

' 方法一：自动调整整个工作表的列宽
Sub AutoFitColumnsInSheetA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("SheetA")
ws.Cells.EntireColumn.AutoFit
End Sub

' 方法二：自动调整指定列范围的列宽
Sub AutoFitSpecificColumnsInSheetA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("SheetA")
ws.Range("A:E").EntireColumn.AutoFit
End Sub

   Set ws = ThisWorkbook.Sheets("SheetA")

' 取消工作表的保护（如果已保护）
If ws.ProtectContents Then
ws.Unprotect
End If

' 添加 I 列作为可编辑区域
ws.Protection.AllowEditRanges.Add Title:="EditableColumnI", Range:=ws.Columns("I")

' 保护工作表
ws.Protect

文档合并

业务场景

在实际工作中，经常会遇到需要将多个 Excel 文件的数据合并到一个工作表中的情况。例如，某公司不同部门每个月都会生成各自的业务数据报表，这些报表格式基本相同，但分别存储在不同的 Excel 文件中。为了进行整体的数据分析和统计，需要将这些分散的文件数据整合到一个文件里。此 VBA 代码就是为解决这类数据合并问题而设计的，它可以从指定文件夹中获取所有 Excel 文件，将它们的数据合并到一个名为 “Combine” 的工作表中，最后还能将合并后的数据保存为一个新的 Excel 文件。

处理逻辑

初始化设置
- 设定主工作簿和控制工作表，控制工作表 “control” 用于存储配置信息，如要合并的文件夹路径、表头行数等。
- 从控制工作表中读取要合并的文件夹路径、表头行数、列宽和新文件的文件名等配置信息。
目标工作表准备
- 检查主工作簿中是否存在名为 “Combine” 的目标工作表，若不存在则创建该工作表。
- 清空目标工作表中的所有内容，为合并数据做准备。
文件遍历与数据合并
- 对指定文件夹中的所有 Excel 文件进行遍历，记录合并的文件数量。
- 依次打开每个 Excel 文件，假设只处理文件中的第一个工作表。
- 找出当前打开文件中第一列有数据的最后一行。
- 若还未复制过表头，就将当前文件的完整数据（从 A1 到 L 列最后一行）复制到目标工作表中；若已复制过表头，则只复制当前文件的数据行（从 A2 到 L 列最后一行）到目标工作表中。
- 关闭当前处理的 Excel 文件，继续处理下一个文件。
错误处理
- 在打开 Excel 文件时，如果出现错误，会弹出消息框提示用户检查文件是否正常，然后继续处理下一个文件。
合并完成提示与保存新文件
- 当所有文件都处理完毕后，弹出消息框提示 “合并完成！”。
- 创建一个新的工作簿，将合并数据所在的目标工作表复制到新工作簿中。
- 按照控制工作表中指定的文件名保存新工作簿，最后关闭新工作簿。

例如之前的拆分，在收集用户的反馈后进行合并。

1. 变量声明区块

vba

Dim folderPath As String
Dim targetSheetName As String
Dim wbMaster As Workbook
Dim wsControl As Worksheet
Dim wbB As Workbook
Dim wsB As Worksheet
Dim lastRow As Long
Dim i As Long
Dim copyRowRange As Range
Dim pasteCol As Long
Dim pasteRow As Long
Dim key1 As String
Dim key2 As String
Dim key3 As String
Dim key4 As String
Dim colWidth As String
Dim rowHeight As Long
Dim checkRow As Long
Dim pasteRows As Long
Dim j As Long
Dim fileCount As Long ' 新增：用于记录合并的文件数量

功能：声明了宏中会用到的各种变量，涵盖字符串变量（如文件夹路径、工作表名称）、工作簿和工作表对象、长整型变量（用于记录行号等）、范围对象等。fileCount 变量用于记录合并的文件数量。

2. 设置主工作簿及控制工作表区块

vba

Set wbMaster = ThisWorkbook
Set wsControl = wbMaster.Sheets("control")

功能：将 wbMaster 设定为当前运行宏的工作簿，把 wsControl 设定为该工作簿中名为 “control” 的工作表，此工作表用于存储配置信息。

3. 获取配置信息区块

vba

folderPath = wsControl.Range("B18").Value
targetSheetName = "Combine"
headerRows = wsControl.Range("B9").Value
colWidth = wsControl.Range("D9").Value
newFileName = wsControl.Range("B19").Value

功能：从控制工作表 “control” 里读取配置信息，像要合并的文件夹路径（B18 单元格）、表头行数（B9 单元格）、列宽（D9 单元格）以及新文件的文件名（B19 单元格）。同时把目标工作表的名称设定为 “Combine”。

4. 设置目标工作表区块

vba

On Error Resume Next
Set wsTarget = wbMaster.Sheets(targetSheetName)
On Error GoTo 0
If wsTarget Is Nothing ThenSet wsTarget = wbMaster.Sheets.Add(After:=wbMaster.Sheets(wbMaster.Sheets.Count))wsTarget.Name = targetSheetName
End If

功能：尝试获取主工作簿中名为 “Combine” 的目标工作表。若该工作表不存在，就会在主工作簿的最后添加一个新的工作表，并将其命名为 “Combine”。

5. 清空目标工作表内容区块

vba

wsTarget.Select
Cells.Select
Selection.ClearContents

功能：选中目标工作表中的所有单元格，然后清空其内容，为后续合并数据做好准备。

6. 初始化变量区块

vba

isTitleCopy = False
lastRow = 0 ' targer 的最后一行

功能：初始化两个变量，isTitleCopy 用于标记表头是否已复制，lastRow 用于记录目标工作表中数据的最后一行，初始值设为 0。

7. 文件遍历与数据合并区块

vba

folderPath = folderPath & "\"
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Filename = Dir(folderPath & "*.xls*")
fileCount = 0 ' 初始化文件数量为 0
Do While Filename <> ""fileCount = fileCount + 1 ' 每次循环，文件数量加 1On Error GoTo OpenErrorHandlerSet wbB = Workbooks.Open(folderPath & Filename)On Error GoTo 0Set wsB = wbB.Sheets(1) ' 这里假设只处理每个工作簿的第一个工作表，可按需修改endRowFrom = wsB.Cells(Rows.Count, 1).End(xlUp).RowcopyStartRow = lastRow + 1If isTitleCopy = False ThenwsB.Range("A1:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)lastRow = endRowFromisTitleCopy = TrueElsewsB.Range("A2:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)lastRow = lastRow + endRowFrom - 1End IfwbB.Close FalseFilename = Dir
Loop

功能：
- 保证文件夹路径以反斜杠结尾。
- 运用 Dir 函数获取指定文件夹中所有扩展名为 .xls 或 .xlsx 的文件。
- 循环处理每个文件，每次循环时 fileCount 加 1。
- 尝试打开文件，若出现错误则跳转到错误处理程序。
- 假设只处理每个工作簿的第一个工作表，找出该工作表第一列有数据的最后一行。
- 若表头还未复制，就将当前文件的完整数据（从 A1 到 L 列最后一行）复制到目标工作表；若表头已复制，则只复制数据行（从 A2 到 L 列最后一行）。
- 关闭当前处理的文件，继续处理下一个文件。

8. 错误处理区块

vba

OpenErrorHandler:MsgBox "打开工作簿 " & Filename & " 时出现错误，请检查文件是否正常。"Resume Next

功能：若在打开文件时出现错误，会弹出消息框提示用户检查文件是否正常，然后继续处理下一个文件。

9. 合并完成提示与保存新文件区块

vba

MsgBox "合并完成！"
Set newWb = Workbooks.Add
wsTarget.Copy Before:=newWb.Sheets(1)
newWb.SaveAs newFileName
newWb.Close SaveChanges:=True

功能：
- 所有文件处理完毕后，弹出消息框提示 “合并完成！”。
- 创建一个新的工作簿。
- 将合并数据所在的目标工作表复制到新工作簿的第一个工作表之前。
- 按照控制工作表中指定的文件名保存新工作簿，最后关闭新工作簿。

10. 退出宏区块

vba

Exit Sub

功能：正常退出宏的执行。

完整代码如下

Sub MergeExcels()' 声明所有变量Dim folderPath As StringDim targetSheetName As StringDim wbMaster As WorkbookDim wsControl As WorksheetDim wbB As WorkbookDim wsB As WorksheetDim lastRow As LongDim i As LongDim copyRowRange As RangeDim pasteCol As LongDim pasteRow As LongDim key1 As StringDim key2 As StringDim key3 As StringDim key4 As StringDim colWidth As StringDim rowHeight As LongDim checkRow As LongDim pasteRows As LongDim j As LongDim fileCount As Long ' 新增：用于记录合并的文件数量' 1. 设置主工作簿及控制工作表Set wbMaster = ThisWorkbookSet wsControl = wbMaster.Sheets("control")' 2. 获取要合并的文件夹路径及目标工作表名folderPath = wsControl.Range("B18").ValuetargetSheetName = "Combine"headerRows = wsControl.Range("B9").ValuecolWidth = wsControl.Range("D9").ValuenewFileName = wsControl.Range("B19").Value' 4. 设置目标工作表，如果不存在则创建On Error Resume NextSet wsTarget = wbMaster.Sheets(targetSheetName)On Error GoTo 0If wsTarget Is Nothing ThenSet wsTarget = wbMaster.Sheets.Add(After:=wbMaster.Sheets(wbMaster.Sheets.Count))wsTarget.Name = targetSheetNameEnd If'CLEAR combine sheet contentwsTarget.SelectCells.SelectSelection.ClearContentsisTitleCopy = FalselastRow = 0 ' targer 的最后一行' 9. 获取文件夹中的所有 Excel 文件并遍历合并folderPath = folderPath & "\"If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"Filename = Dir(folderPath & "*.xls*")fileCount = 0 ' 初始化文件数量为 0Do While Filename <> ""fileCount = fileCount + 1 ' 每次循环，文件数量加 1On Error GoTo OpenErrorHandlerSet wbB = Workbooks.Open(folderPath & Filename)On Error GoTo 0Set wsB = wbB.Sheets(1) ' 这里假设只处理每个工作簿的第一个工作表，可按需修改endRowFrom = wsB.Cells(Rows.Count, 1).End(xlUp).RowcopyStartRow = lastRow + 1If isTtileCopy = False ThenwsB.Range("A1:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)lastRow = endRowFromisTtileCopy = TrueElsewsB.Range("A2:L" & endRowFrom).Copy wsTarget.Range("A" & copyStartRow)lastRow = lastRow + endRowFrom - 1End If' 16. 关闭当前遍历的工作簿wbB.Close FalseFilename = DirLoopMsgBox "合并完成！"'创建一个新的工作簿Set newWb = Workbooks.Add'将原工作表复制到新工作簿wsTarget.Copy Before:=newWb.Sheets(1)'保存新工作簿到指定路径newWb.SaveAs newFileName'关闭新工作簿newWb.Close SaveChanges:=TrueExit Sub
OpenErrorHandler:MsgBox "打开工作簿 " & Filename & " 时出现错误，请检查文件是否正常。"Resume Next
End Sub