当Excel数据行数过多时,打开文件、查看数据不太方便快捷,而将工作表中的数据按行拆分是一个选择
工作表按行拆分为工作表
Sub 工作表按行拆分为工作表()
'当前工作表(worksheet)按固定行数拆分为多个工作表,保存在当前工作簿(workbook)
Set ws = Application.ActiveSheet '当前工作表即为待拆分工作表
title_row = 1 '表头行数,每个拆分后的sheet都保留
num_row = 100 '拆分数据行数,按多少行数据进行拆分,不能完全拆分的,多余行数单独
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") '本行复制表头,下行复制数据
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
End Sub
(更新2022.01.09:生成的拆分表列宽为Excel表格默认列宽,如需修改为原数据表格的列宽,则做如下修改
ws.Rows(1 & ":" & title_row).Copy .Range("A1")
'将以上代码修改为以下
ws.Rows(1 & ":" & title_row).Copy
.Range("A1").PasteSpecial Paste:=xlPasteAll
.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths
仅表头列宽修改一次即可)
工作表按行拆分为工作薄
Sub 工作表按行拆分为工作薄()
'当前工作表(worksheet)按固定行数拆分保存为多个工作簿(workbook),文件单独保存
tm = Now()
Application.Visible = False '后台运行,不显示界面
Application.DisplayAlerts = False '不显示警告信息
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = Application.ActiveSheet '当前工作表即为待拆分工作表
wb_path = Application.ActiveWorkbook.Path '当前工作簿文件路径
wb_name = Application.ActiveWorkbook.Name '当前工作簿文件名和扩展名
save_path = wb_path + "\拆分表" '保存拆分后的表格保存路径
title_row = 1 '表头行数,每个拆分后的sheet都保留
num_row = 100 '拆分数据行数,按多少行数据进行拆分,不能完全拆分的,多余行数单独
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") '本行复制表头,下行复制数据
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
举例:按行拆分
原始数据
参数:表头行数title_row = 1、按每5行拆分num_row = 5
拆分为工作表-1
拆分为工作表-2
拆分为工作薄