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
相关推荐
William_cl5 分钟前
【连载3】MySQL 的 MVCC 机制剖析
数据库·mysql
2351610 分钟前
【MySQL】MVCC:从核心原理到幻读解决方案
java·数据库·后端·sql·mysql·缓存
zym大哥大14 分钟前
高并发内存池
服务器·数据库·windows
扶苏-su15 分钟前
Java---注解
java·注解
. . . . .32 分钟前
数据库迁移migration
数据库
MX_93591 小时前
SpringBoot项目优先级以及bean的管理
java·spring boot·后端·spring
shixian10304111 小时前
Django 学习日志
数据库·学习·sqlite
Flash Dog1 小时前
【线程池】——实用场景
java
元亓亓亓2 小时前
SSM--day4--SpringMVC(补充)
java·后端·ssm
IT 小阿姨(数据库)2 小时前
PostgreSQL通过pg_basebackup物理备份搭建流复制备库(Streaming Replication Standby)
运维·服务器·数据库·sql·postgresql·centos