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
相关推荐
技术钱1 分钟前
vue3 封装图片上传预览组件支持docx、excel、pdf、图片、txt格式
vue.js·pdf·excel
疯狂吧小飞牛2 分钟前
Lua C API 中的注册表介绍
java·c语言·lua
kyle~7 分钟前
C++--- override 关键字 强制编译器验证当前函数是否重写基类的虚函数
java·前端·c++
wangmengxxw13 分钟前
Redis概述
数据库·redis·缓存
Hello.Reader15 分钟前
Flink 受管状态的自定义序列化原理、实践与可演进设计
java·网络·flink
笔生花19 分钟前
【实战-12】flink版本表
数据库·sql·flink
花月C23 分钟前
高效查找数据的数据结构—MySQL 索引
数据结构·数据库·mysql
让我上个超影吧27 分钟前
设计模式【工厂模式和策略模式】
java·设计模式·策略模式
我笔记36 分钟前
关系型数据库RDBMS与非关系型数据库NoSQL区别
数据库·oracle
PiscesCanon1 小时前
达梦开启awr功能报错:[-7160]:Object [DBMS_WORKLOAD_REPOSITORY_DATA_LOW] is invalid
数据库·mysql