【excel实战】五万行Excel拆成五十多个小文件，我以前手动干，现在10秒搞定

前段时间帮朋友处理一个客户数据表五万多行。对方系统每次只能导入1000行而且每个文件都得带表头。一开始我是手动干的选中1000行、复制、新建工作簿、粘贴表头、粘贴数据、另存为、起个文件名……拆到第十个的时候人就麻了。五万多行要拆五十多个文件全靠手点一下午就交代进去了。后来写了段VBA再遇到这种活直接跑一遍几秒钟的事。代码放这儿你直接抄去用就行Sub SplitExcelByRows() Dim wsSource As Worksheet Dim wbTarget As Workbook Dim lastRow As Long Dim totalDataRows As Long Dim rowsPerFile As Long Dim fileCount As Long Dim i As Long Dim startRow As Long Dim endRow As Long Dim savePath As String Dim baseName As String Dim newFileName As String On Error GoTo ErrorHandler Set wsSource ThisWorkbook.Worksheets(Sheet1) rowsPerFile 1000 lastRow wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row If lastRow 2 Then MsgBox 数据不足无法拆分 Exit Sub End If totalDataRows lastRow - 1 fileCount (totalDataRows rowsPerFile - 1) \ rowsPerFile savePath ThisWorkbook.Path If savePath Then MsgBox 请先保存当前工作簿再运行此程序 Exit Sub End If baseName Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, .) - 1) Application.ScreenUpdating False Application.DisplayAlerts False For i 1 To fileCount DoEvents Set wbTarget Workbooks.Add(xlWBATWorksheet) 复制表头 wsSource.Rows(1).Copy Destination:wbTarget.Worksheets(1).Rows(1) startRow 2 (i - 1) * rowsPerFile endRow startRow rowsPerFile - 1 If endRow lastRow Then endRow lastRow wsSource.Range(A startRow :A endRow).EntireRow.Copy _ Destination:wbTarget.Worksheets(1).Rows(2) newFileName savePath \ baseName _Part i .xlsx wbTarget.SaveAs Filename:newFileName, FileFormat:xlOpenXMLWorkbook wbTarget.Close SaveChanges:False Next i Application.ScreenUpdating True Application.DisplayAlerts True MsgBox 拆分完成共生成 fileCount 个文件每个文件包含列名和最多1000行数据 Exit Sub ErrorHandler: Application.ScreenUpdating True Application.DisplayAlerts True MsgBox 发生错误 Err.Description End Sub用法打开你的文件AltF11打开VBA编辑器插入模块把代码贴进去F5运行。跑完会弹个提示去原文件所在的文件夹看拆出来的文件都在那儿名字是“原文件名_Part1”“原文件名_Part2”这样排下去的。有两个前提要注意数据得放在名叫Sheet1的表里工作簿本身得先保存过因为代码要取它所在的目录。代码里有几处可以聊聊第一个是算要拆几个文件这行fileCount (totalDataRows rowsPerFile - 1) \ rowsPerFile比如2500行数据每个文件1000行得拆3个而不是2个因为最后那500行也得有个文件装。VBA里没有现成的向上取整函数(a b - 1) \ b这个写法是最省事的等价方案不算VBA专属技巧很多语言里都能这么写记一下以后用得上。第二个是找最后一行lastRow wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row从A列最底下往上摸碰到第一个非空单元格停。不管数据是一千行还是一百万行都能找准边界。我见过不少人写死一个Range(A10000)数据一超就出错这个写法就没这个坑。第三处是取文件名baseName Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, .) - 1)这里用的是InStrRev从后往前找小数点而不是InStr。区别在于如果你的文件叫“2024.09报表.xlsxInStr找到的是第一个点截出来就成2024了InStrRev找的是最后一个点才能正确取出完整文件名。这个坑我踩过你们别再踩。最后一处是开头那两行Application.ScreenUpdating False Application.DisplayAlerts False关掉屏幕刷新和系统弹窗拆几十个文件的时候速度快很多屏幕也不会闪个不停。但重点其实在错误处理那段——出错的时候也把它们改回来。很多人只记得开头关忘了出错后开结果程序一崩Excel就留在那个“不刷新、不弹窗”的傻状态看着像卡死了。别小看这个细节。想改的话每个文件装多少行改rowsPerFile 1000这一行改成500、2000随你。数据不在Sheet1的话把Worksheets(Sheet1)里的表名换掉。输出文件的命名在后半段那句newFileName里比如想把_Part改成“_批次”改字符串就行。另外说一句拆出来的文件存的是xlsx格式公式会保留算出来的值但原文件里如果带宏宏不会被带过去。拆之前最好还是备份一下原表虽然这代码不动原数据但备份这个习惯总没坏处。写这段代码花了不到十分钟但省下的时间已经数不清了。其实按部门拆、按月份拆跟按行数拆是一个思路改改循环里的判断条件的事。有想看的具体场景可以留言我后面挑几个写写。觉得有用就转给那个还在手动复制粘贴的同事吧。