如何将一个EXCEL文件里面很多条数据拆分成多个文件,比如一个EXCEL表里面有90万行数据,需要按照每1万行拆分成一个文件,也就是需要将这表里面的90万行数据拆分到90个文件里面。这个如果手工拆分,那工作量实在太大了。实际上这也是大数据处理过程中会涉及的一个概念——数据分框。
EXCEL代码如下:
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
EXCEL文件处理结果如下:
555
555