如何快速的将EXCEL表格数据拆分成多个文件？
前不久好几位朋友都问到，如何将一个EXCEL文件里面很多条数据拆分成多个文件，比如一个EXCEL表里面有90万行数据，需要按照每1万行拆分成一个文件，也就是需要将这表里面的90万行数据拆分到90个文件里面。这个如果手工拆分，那工作量实在太大了。于是，我就想把这个过程拿出来分享一下。实际上这也是大数据处理过程中会涉及的一个概念——数据分框。
下面我们就来看看如何用VBA来实现拆分工作。
首先，在EXCEL里面插入一个模块，代码如下：
Sub copybat()
Dim n As Integer
Dim i As Integer
Dim k As Integer
Dim path As String
Dim filename As String
path = `c:拆分测试` '预定义的存储路径 filename = `分割文件` '预定义的文件名 Application.ScreenUpdating = False
i = 10 '分页数据条目数 k = 0 '循环执行次数，用于标识文件顺序 For n = 1 To Cells(1, 1).End(xlDown).Row Step i '开始循环到数据表底部，步长为分页条目数 Range(`A1:D1,A` & n 1 & `:D` & n i).Select '每次均选择复制固定的表头和本次循环内的数据行 Selection.Copy
Workbooks.Add '新建工作簿 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '特殊粘贴：只粘贴数值 k = k 1
ActiveWorkbook.SaveAs filename:=path & filename & k & `.xlsx`, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False '将文件按命名规则另存至指定位置 ActiveWindow.Close '关闭已经生成的文件 Next n
MsgBox `分割完毕！`, vbDefaultButton1, `提示`
Application.ScreenUpdating = true
End Sub第二，在EXCEL工作表里面插入一个按钮控件，用于调用并执行以上模块。
第三，点击按钮，执行代码。最后结果如下：
文件夹下生成的文件图例
分割的第1小部分
分割的第2小部分
以上，是一个大体的过程，实际上还可以在此基础上实现更加复杂的逻辑，这就又各位独立发挥了。
二次更新：
鉴于以上处理代码仅为一个框架性的代码，好多知乎朋友来咨询为什么直接复制过去使用出现各种问题，于是乎，本人直接修改了一个更加完全的版本，基本上不需要再去做过多修改，并且逻辑要更加完善，直接使用即可不需要修改。在办公领域，毕竟不是所有人都需要精通VBA，还是得照顾一下不是很熟悉VBA的朋友。以下是代码，：
Sub copybat()
Dim i, j, k, m, r As Integer
Dim n, total_data As Long
Dim path As String
Dim title_area, data_column, data_areas As Range
Set title_area = Application.InputBox(prompt:=`请用鼠标选择表头及表标题所在区域`, title:=`选择`, Type:=8) '选取表头区域 Set data_column = Application.InputBox(prompt:=`请鼠标选择需要拆分数据的开始行区域`, title:=`选择`, Type:=8) '选取拆分起始处 m = data_column.Row '获取分割开始行所在区域行号 r = data_column.Column '获取分割开始行所在区域列号 j = data_column.Columns.Count '获取分割开始行区域列数 i = Application.InputBox(prompt:=`请输入每次分割数据条目数`, title:=`选择`)
'获取需要分割的数据总条数。这里，可以用两种办法获取到数据区域的尾部行号 '第一种，使用传统的：End(xlDown).Row，优点是速度快，缺点是有空白行时会出错 '第二种，使用查找方式find，优点是基本不会出错，缺点是条数较多时候可能会慢一点 'total_data = Cells(data_column(1, 1)).End(xlDown).Row - m 1 total_data= Cells.Find(`*`, LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row- m 1
If MsgBox(`本次分割文件数据总数为:` & total_data & `条，将会被分割成` & WorksheetFunction.RoundUp(total_data / i, 0) & `个文件，` _
& `点击“确定”开始分割，点击“取消”返回`, vbOKCancel, `确认`) = vbOK Then
filename = Application.InputBox(prompt:=`请输入分割后的文件主名，默认为“分割文件”`, title:=`选择`, Default:=`分割文件`)
With Application.FileDialog(msoFileDialogFolderPicker) '获取分割后的文件存储路径 If .Show = False Then Exit Sub
path = .SelectedItems(1)&`` '加入``,否则，文件会被存储到选定路径的上一层 End With
Application.ScreenUpdating = False
k = 0 '第几次分割输出，用于标识分割文件次数 For n = m To total_data Step i '从开始分割的行往下计数 Set data_areas = Range(Cells(n, r), Cells(n i - 1, j)) '设置每次循环体内的分割数据主体 Application.Union(title_area, data_areas).Select '把表头区域以及本次循环体内的数据区域进行合并 Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
, SkipBlanks:=False, Transpose:=False '特殊粘贴：包含源格式的粘贴，以便保持所有格式一致 k = k 1
ActiveWorkbook.SaveAs filename:=path & filename & `_` & k & `.xlsx`, FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False '按照既有的文件名、路径、循环次数合并起来存储文件 ActiveWindow.Close
Next n
MsgBox `文件分割完毕！`, vbDefaultButton1, `提示`
End If
Application.ScreenUpdating = True
End Sub第三次更新：
之前评论区有部分朋友提到会报错的问题，主要在于以下几方面需要注意：
1、最后分割时候报错的问题。主要在于选取数据拆分开始行区域时候需要选定开始行整行数据区域；
2、分拆的文件比实际数据多的问题。主要在于，数据区域底部有空行或者空格之类的单元格，导致“End(xlDown)”语句识别错误。
3、保存时候总是保存到选定路径的上一层。这个问题主要在于本人的原因造成的，因一时疏忽大意，在路径变量部分： “path = .SelectedItems(1)”，后面少输了一个“”。目前已经更改完毕，在此深表抱歉！
其它实用内容
郭大牛：根据EXCEL数据自动生成WORD文档
郭大牛：分析报告自动化——Excel与Word数据互通
郭大牛：使用Excel自动批量发送邮件
郭大牛：Excel向Word输出复杂图文
郭大牛：Excel中一个被严重忽视的大杀器功能
郭大牛：打造Excel与微信之间的交互渠道
郭大牛：VBA实现高级筛选
郭大牛：无边界办公——远程虚拟应用架构
郭大牛：无边界办公——WebDAV文件共享服务构建
郭大牛：无边界办公—内网穿透
郭大牛：Excel树形多级下拉菜单的应用
郭大牛：巧用数据验证制作模糊匹配的下拉列表
郭大牛：使用VBA自动生成文件目录制作文件管理系统
郭大牛：使用Excel来制作批命令完成重复工作
郭大牛：将数字金额转换为中文大写金额的方法
郭大牛：Excel多级下拉菜单制作
郭大牛：使用Access制作一个简单的收款管理及票据打印系统方法
郭大牛：如何使用最简单的办法实现中小企业的数据共享和办公协同？
郭大牛：一个基于Access构建的数据管理平台
郭大牛：基于EXCEL的条形码制作工具
郭大牛：基于EXCEL的财务数据查询工具
郭大牛：用友打印设置
评论列表