盛达优配官网-湖北配资平台-宁波股票配资网-炒股配资网

宁波股票配资网 ws.Cells(1

本VBA代码设计用于合并同一文件夹下所有Excel文件（包括 .xls 和 .xlsx 格式）中结构相同的工作表数据，生成一个包含所有数据的综合工作表。代码通过文件系统对象（FSO）自动遍历指定文件夹中的Excel文件，提取每个工作表的数据并将其合并到新建的工作表中，仅保留一次表头。代码包含详细注释，便于理解和维护，适合需要批量整合Excel数据的场景。运行前，请确保所有工作表具有一致的表头结构，并正确设置文件夹路径，以保证合并结果的准确性和完整性。

Sub MergeExcelFiles ' 声明变量 Dim fso As Object ' 文件系统对象，用于处理文件夹和文件 Dim folder As Object ' 文件夹对象 Dim file As Object ' 文件对象 Dim wb As Workbook ' 当前处理的Excel文件工作簿对象 Dim ws As Worksheet ' 循环处理的工作表对象 Dim wsMaster As Worksheet ' 合并结果的目标工作表 Dim rng As Range ' 数据范围 Dim lastRow As Long ' 最后一行号 Dim lastCol As Long ' 最后一列号 Dim targetRow As Long ' 目标工作表的当前行号 Dim firstDataRow As Long ' 数据开始行（通常为第2行，跳过表头） Dim folderPath As String ' 文件夹路径 Dim fileExtension As String ' 文件扩展名 Dim app As Application ' Excel应用程序对象 ' 设置错误处理 On Error GoTo ErrorHandler ' 初始化Excel应用程序对象 Set app = Application ' 设置文件夹路径（可修改为实际路径或使用文件夹选择对话框） folderPath = "C:\YourFolderPath\" ' 请替换为实际文件夹路径 fileExtension = "*.xls*" ' 兼容.xls和.xlsx文件 ' 创建文件系统对象 Set fso = CreateObject("Scripting.FileSystemObject") ' 检查文件夹是否存在 If Not fso.FolderExists(folderPath) Then MsgBox "指定的文件夹路径不存在: " & folderPath, vbCritical Exit Sub End If Set folder = fso.GetFolder(folderPath) ' 初始化当前工作簿 Set wb = ThisWorkbook ' 创建新的目标工作表用于存放合并数据 Set wsMaster = wb.Worksheets.Add(Before:=wb.Worksheets(1)) wsMaster.Name = "Merged_Data_" & Format(Now, "yyyymmdd_hhmmss") ' 初始化目标行的起始位置 targetRow = 1 ' 遍历文件夹中的每个Excel文件 For Each file In folder.Files ' 检查文件是否为Excel文件（包括.xls和.xlsx） If LCase(file.Name) Like LCase(fileExtension) Then ' 打开当前Excel文件 Set wb = app.Workbooks.Open(file.Path) ' 遍历当前工作簿中的每个工作表 For Each ws In wb.Worksheets ' 找到当前工作表的最后一列 lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column ' 如果是第一个处理的工作表，复制表头 If targetRow = 1 Then ' 复制表头到目标工作表 ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Copy _ Destination:=wsMaster.Cells(targetRow, 1) targetRow = targetRow + 1 End If ' 找到当前工作表的最后一行 lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' 设置数据开始行为第2行（假设第1行为表头） firstDataRow = 2 ' 如果有数据（行数大于表头行） If lastRow >= firstDataRow Then ' 设置数据范围（从第2行到最后一行，所有列） Set rng = ws.Range(ws.Cells(firstDataRow, 1), ws.Cells(lastRow, lastCol)) ' 复制数据到目标工作表 rng.Copy Destination:=wsMaster.Cells(targetRow, 1) ' 更新目标行号 targetRow = targetRow + rng.Rows.Count End If Next ws ' 关闭当前工作簿，不保存更改 wb.Close SaveChanges:=False End If Next file ' 自动调整目标工作表列宽 wsMaster.Columns.AutoFit ' 显示完成消息 MsgBox "所有Excel文件的数据已合并到 " & wsMaster.Name, vbInformation ' 清理对象引用 Set wsMaster = Nothing Set wb = Nothing Set folder = Nothing Set fso = Nothing Set app = Nothing Exit SubErrorHandler: ' 显示错误信息 MsgBox "发生错误: " & Err.Description, vbCritical ' 清理对象引用 If Not wb Is Nothing Then wb.Close SaveChanges:=False Set wsMaster = Nothing Set wb = Nothing Set folder = Nothing Set fso = Nothing Set app = NothingEnd Sub运行说明将此代码复制到Excel的VBA编辑器中（Alt+F11）。修改代码中的 folderPath 变量为实际文件夹路径（例如 "C:\Data"）。确保所有Excel文件（.xls 或 .xlsx）的工作表具有相同的结构（相同的列标题）。运行宏（F5或通过Excel的宏菜单）。合并结果将生成在名为"Merged_Data_日期时间"的新工作表中。注意事项请确保目标文件夹路径正确且可访问。所有工作表需具有一致的表头结构，以确保合并结果的准确性。建议备份数据以防意外数据丢失。代码会自动关闭处理过的Excel文件，以避免内存问题。如果文件夹中包含其他类型的 .xls* 文件（如 .xlsm），它们也会被处理；如需限制，仅处理 .xls 和 .xlsx，需进一步修改 fileExtension 逻辑。

盛达优配官网-湖北配资平台-宁波股票配资网-炒股配资网提示：文章来自网络，不代表本站观点。