Excel怎样快速将一张表按条件分为多张表
前言
本篇主要记录如何将一张大数据量的表格按照某一列分割成多个xlsx单表文件的方法。提供了两种方法,两种方法视要求使用。1
按数据透视图拆分
按某一列拆分多表
-
首先点击 插入——数据透视表
-
选择新工作表或在当前工作表中选择一片区域,建议选择新工作表。
-
将用作筛选的拖入筛选框,其它拖入行框
-
选择 设计——分类汇总下拉——不显示分类汇总
-
选择 总计下拉——对行和列禁用
-
选择 报表布局下拉——以表格形式显示
-
选择 数据透视表分析——选项下拉——显示报表筛选页
-
点击确定等待一会,就可以看到自动生成出按筛选条件的各个工作表。
由工作表生成文件
-
选择 开发工具——Visual Basic(或直接ALT+F11),弹出VBA界面,随便选个工作表右键,选择插入——模块
-
复制以下代码进入代码框(自己改下路径,别傻乎乎复制 🤪)
Sub SplitEachWorksheet() Dim FPath As String '这是当前文件路径 FPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False For Each ws In ThisWorkbook.Sheets ws.Copy ' 改存储路径在这里 Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx" Application.ActiveWorkbook.Close False Next Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
-
点这个执行就好了
按原表格式拆分代码
Sub 工作表按列拆分为工作簿()
'当前工作表(worksheet)按固定某列的值拆分为多个工作簿(workbook),文件单独保存
Dim arr, dict As Object
Set dict = CreateObject("scripting.dictionary"): tm = Timer
Set fso = CreateObject("Scripting.FileSystemObject")
'--------------------参数填写:num_col,数字,A列为1向右递增;title_row,数字,第1行为1向下递增
num_col = 4 '关键值列,按该列的值进行拆分,相同的保存在同一ws
title_row = 1 '表头行,每个拆分后的sheet都保留
Set ws = Application.ActiveSheet
wb_path = Application.ActiveWorkbook.Path '当前工作簿文件路径
wb_name = Application.ActiveWorkbook.Name '当前工作簿文件名和扩展名
save_path = wb_path + "\拆分表" '保存拆分后的表格保存路径
If Not fso.FolderExists(save_path) Then fso.CreateFolder (save_path) '创建文件夹
Application.ScreenUpdating = False '关闭屏幕更新,加快程序运行
Application.DisplayAlerts = False '不显示警告信息
arr = ActiveSheet.UsedRange '所有数据行读取为数组,也可arr = [a1].CurrentRegion
For i = title_row + 1 To UBound(arr): '遍历关键值列,写入字典,key为关键值,item为对应的行
If Not dict.Exists(arr(i, num_col)) Then '新键-值
Set dict(arr(i, num_col)) = Rows(i)
Else '已有键-值,更新
Set dict(arr(i, num_col)) = Union(dict(arr(i, num_col)), Rows(i))
End If
Next
k = dict.Keys:v = dict.Items
For i = 0 To dict.count - 1: '遍历字典,创建、写入wb
Workbooks.Add
With ActiveSheet
ws.Rows(1).Copy
.[a1].PasteSpecial Paste:=xlPasteColumnWidths '复制列宽
ws.Rows(1 & ":" & title_row).Copy .[a1] '复制表头
v(i).Copy .Range("A" & title_row + 1) '复制数据
End With
'保存文件全名(文件路径、文件名、扩展名),keys命名
save_file = save_path & "\" & fso.GetBaseName(wb_name) & "_拆分表_" & k(i) & "." & fso.GetExtensionName(wb_name)
ActiveWorkbook.SaveAs filename:=save_file
ActiveWorkbook.Close (False)
'Exit For '强制退出for循环,单次测试使用
Next
Set fso = Nothing '释放内存
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Debug.Print "工作表已拆分完成,累计用时" & Format(Timer - tm, "0.00") '耗时
End Sub