Excel拆分脚本

Excel拆分

工作表按行拆分为工作薄

打开要拆分的Excel文件,使用==快捷键(Alt+F11)==打开脚本界面,选择要拆分的sheet,打开Module,在Module中输入脚本代码,然后运行脚本

java 复制代码
Sub 工作表按行拆分为工作薄()
    Dim tm As Date
    Dim fso As Object
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim newWb As Workbook
    Dim savePath As String
    Dim wbPath As String
    Dim wbName As String
    Dim saveFile As String
    Dim titleRow As Long
    Dim numRows As Long
    Dim maxRow As Long
    Dim sheetCount As Long
    Dim i As Long
    Dim lastRowCopied As Long
    
    ' 初始化
    tm = Now
    Application.Visible = False
    Application.DisplayAlerts = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 参数设置
    titleRow = 1
    numRows = 50000
    Set ws = ThisWorkbook.ActiveSheet
    wbPath = ThisWorkbook.Path
    wbName = ThisWorkbook.Name
    savePath = wbPath & "\split"
    
    ' 创建保存路径文件夹(如果不存在)
    If Not fso.FolderExists(savePath) Then
        fso.CreateFolder savePath
    End If
    
    ' 计算最大行数和拆分后的工作表数量
    maxRow = ws.UsedRange.Rows.Count
    sheetCount = WorksheetFunction.RoundUp((maxRow - titleRow) / numRows, 0)
    
    ' 循环拆分并保存工作簿
    On Error GoTo ErrorHandler
    For i = 1 To sheetCount
        ' 创建新工作簿
        Set newWb = Workbooks.Add
        With newWb.Sheets(1)
            ' 复制表头
            ws.Rows("1:" & titleRow).Copy Destination:=.Rows("1:" & titleRow)
            ' 复制数据
            lastRowCopied = numRows * (i - 1) + titleRow + numRows
            If lastRowCopied > maxRow Then lastRowCopied = maxRow
            ws.Rows(numRows * (i - 1) + titleRow + 1 & ":" & lastRowCopied).Copy Destination:=.Rows(titleRow + 1)
            ' 复制列宽(可选)
            .Columns("A:Z").AutoFit ' 或者指定需要的列
        End With
        
        ' 保存新工作簿
        saveFile = savePath & "\" & fso.GetBaseName(wbName) & "_split" & i & "." & fso.GetExtensionName(wbName)
        newWb.SaveAs Filename:=saveFile
        newWb.Close False
        Set newWb = Nothing ' 释放新工作簿对象
    Next i
    
    ' 清理和恢复设置
    Set fso = Nothing
    Application.Visible = True
    Application.DisplayAlerts = True
    Debug.Print "工作表已拆分完成,累计用时" & Format(Now() - tm, "hh:mm:ss")
    Exit Sub
    
ErrorHandler:
    MsgBox "错误 " & Err.Number & ": " & Err.Description, vbCritical
    ' 清理和恢复设置(错误处理中的清理)
    If Not newWb Is Nothing Then newWb.Close False
    Set fso = Nothing
    Application.Visible = True
    Application.DisplayAlerts = True
End Sub
相关推荐
能摆一天是一天7 小时前
JAVA stream().flatMap()
java·windows
睡觉的时候不会困7 小时前
Redis 主从复制详解:原理、配置与主从切换实战
数据库·redis·bootstrap
颜如玉8 小时前
🤲🏻🤲🏻🤲🏻临时重定向一定要能重定向🤲🏻🤲🏻🤲🏻
java·http·源码
程序员的世界你不懂9 小时前
【Flask】测试平台开发,新增说明书编写和展示功能 第二十三篇
java·前端·数据库
星空寻流年9 小时前
设计模式第一章(建造者模式)
java·设计模式·建造者模式
自学也学好编程9 小时前
【数据库】Redis详解:内存数据库与缓存之王
数据库·redis
gb421528710 小时前
java中将租户ID包装为JSQLParser的StringValue表达式对象,JSQLParser指的是?
java·开发语言·python
JAVA不会写10 小时前
在Mybatis plus中如何使用自定义Sql
数据库·sql
IT 小阿姨(数据库)10 小时前
PgSQL监控死元组和自动清理状态的SQL语句执行报错ERROR: division by zero原因分析和解决方法
linux·运维·数据库·sql·postgresql·centos
曾经的三心草10 小时前
Python2-工具安装使用-anaconda-jupyter-PyCharm-Matplotlib
android·java·服务器