VBA excel 表格将多行拆分成多个表格或 文件 或者合并 多个表格 |
您所在的位置：网站首页 › excel按姓名拆分成多个表怎么操作出来 › VBA excel 表格将多行拆分成多个表格或 文件 或者合并 多个表格 |
VBA excel 表格将多行拆分成多个表格或 文件 或者合并 多个表格
|
excel 表格 拆分 合并
拆分工作表按行拆分为工作表工作表按行拆分为工作薄
合并操作步骤
拆分
为了将Excel中的数万行数据拆分成多个个每个固定行数的独立工作表，并且保留每个工作表的表头，你可以使用以下VBA脚本。这个脚本会复制表头到每个新的工作表，并将后续的数据行按固定行行的间隔进行拆分 工作表按行拆分为工作表 Sub 工作表按行拆分为工作表() '当前工作表（worksheet）按固定行数拆分为多个工作表，保存在当前工作簿（workbook） tm = Now() Set ws = Application.ActiveSheet '当前工作表即为待拆分工作表 '--------------------参数填写：num_row，数字；title_row表头行数，数字，第1行为1向下递增 title_row = 1 '表头行数，每个拆分后的sheet都保留 num_row = 20000 '拆分数据行数，按多少行数据进行拆分，不能完全拆分的，多余行数单独 max_row = ActiveSheet.UsedRange.Rows.Count '拆分sheet数量，向上取整 sheet_count = WorksheetFunction.RoundUp((max_row - title_row) / num_row, 0) For i = 1 To sheet_count: Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "拆分表" & i '最后添加新sheet，并命名 With ActiveSheet ws.Rows(1 & ":" & title_row).Copy '本行复制表头，下行复制数据 .Range("A1").PasteSpecial Paste:=xlPasteAll .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ws.Rows(num_row * (i - 1) + title_row + 1 & ":" & (num_row * i) + title_row).Copy .Range("A" & title_row + 1) End With 'Exit For '强制退出for循环，单次测试使用 Next Debug.Print ("拆分完成，累计用时" & Format(Now() - tm, "hh:mm:ss")) '耗时 End Sub 工作表按行拆分为工作薄 Sub 工作表按行拆分为工作薄() '当前工作表（worksheet）按固定行数拆分保存为多个工作簿（workbook），文件单独保存 tm = Now() Application.Visible = False '后台运行，不显示界面 Application.DisplayAlerts = False '不显示警告信息 Set fso = CreateObject("Scripting.FileSystemObject") '--------------------参数填写：num_row，数字；title_row表头行数，数字，第1行为1向下递增 title_row = 1 '表头行数，每个拆分后的sheet都保留 num_row = 20000 '拆分数据行数，按多少行数据进行拆分，不能完全拆分的，多余行数单独 Set ws = Application.ActiveSheet '当前工作表即为待拆分工作表 wb_path = Application.ActiveWorkbook.Path '当前工作簿文件路径 wb_name = Application.ActiveWorkbook.Name '当前工作簿文件名和扩展名 save_path = wb_path + "\拆分表" '保存拆分后的表格保存路径 max_row = ActiveSheet.UsedRange.Rows.count '拆分sheet数量，向上取整 sheet_count = WorksheetFunction.RoundUp((max_row - title_row) / num_row, 0) If fso.FolderExists(save_path) Then Debug.Print ("拆分文件保存路径已存在：" & save_path) Else fso.CreateFolder (save_path) Debug.Print ("拆分文件保存路径已创建：" & save_path) End If For i = 1 To sheet_count: Workbooks.Add With ActiveSheet ws.Rows(1 & ":" & title_row).Copy '本行复制表头，下行复制数据 .Range("A1").PasteSpecial Paste:=xlPasteAll .Range("A1").PasteSpecial Paste:=xlPasteColumnWidths ws.Rows(num_row * (i - 1) + title_row + 1 & ":" & (num_row * i) + title_row).Copy .Range("A" & title_row + 1) End With '保存文件全名（文件路径、文件名、扩展名） save_file = save_path & "\" & fso.GetBaseName(wb_name) & "_拆分表" & i & "." & fso.GetExtensionName(wb_name) ActiveWorkbook.SaveAs filename:=save_file ActiveWorkbook.Close (False) 'Exit For '强制退出for循环，单次测试使用 Next Set fso = Nothing '释放内存 Application.Visible = True Application.DisplayAlerts = True Debug.Print ("工作表已拆分完成，累计用时" & Format(Now() - tm, "hh:mm:ss")) '耗时 End Sub 合并首先需要把多个需要合并excel表都放在同一个文件夹里面，并在这个文件夹里面新建一个excel文件 Sub 合并当前目录下所有工作簿的全部工作表() Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Long Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & "\" & "*.xls") AWbName = ActiveWorkbook.Name Num = 0 Do While MyName "" If MyName AWbName Then Set Wb = Workbooks.Open(MyPath & "\" & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range("B1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示" End Sub 操作步骤打开Excel并按下Alt + F11打开VBA编辑器。 在VBA编辑器中，右键点击你的工作簿名称，然后选择插入 -> 模块，以创建一个新的模块。
在新模块的代码窗口中，复制并粘贴以下VBA代码： 确保你的数据在Sheet1上（或者将代码中的"Sheet1"替换为你的实际工作表名称）。 运行这个VBA脚本（你可以通过按F5键，或者点击工具栏上的“运行”按钮 -> 运行子/用户窗体）。 分拆：脚本将会创建一个或多个新工作表（命名为"Part 1"、"Part 2"等），并将数据从源工作表复制到这些新工作表中，每个工作表包含2万行（以2万行为例 可进行调整）（或最后一组可能少于2万行，如果总行数不是2万的整数倍）。 合并：所有的合并到新的表格， 按需粘入代码即可 |
【本文地址】
今日新闻 |
推荐新闻 |