如何将一个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文件处理结果如下:
v2-0a450f6750ddd90e9167491145ac06c7_720w.jpg

最后修改:2021 年 09 月 02 日 01 : 28 PM
如果觉得我的文章对你有用,请随意赞赏