根据某一列拆分Excel为多个表格

最新推荐文章于 2025-06-29 16:31:18 发布

原创

最新推荐文章于 2025-06-29 16:31:18 发布 · 1.2w 阅读

11 ·

CC 4.0 BY-SA版权

文章标签：

#Excel #VBA

这篇博客介绍了如何使用VBA自动化地将一个Excel工作表根据某一列的值拆分成多个单独的工作表。首先，代码会删除除当前活动工作表外的所有其他工作表。然后，用户可以选择标题区域和拆分列。根据拆分列的值，每个不同的值都会创建一个新的工作表，并将对应的数据复制到新的工作表中，保持原有标题不变。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Option Explicit
Option Base 1

Sub SplitData()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim self As Worksheet
    Set self = ActiveSheet
    
    Dim nLastRowNum As Long
    Dim nLastColumnNum As Long
    
    Dim i As Long
    
    ' 删除其他的sheet
    
    For i = Sheets.Count To 1 Step -1
        If Sheets(i).Name <> self.Name Then
            Sheets(i).Delete
        End If
    Next i

    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    
    '获取全部数据范围
    nLastRowNum = Cells(Rows.Count, 1).End(xlUp).Row
    nLastColumnNum = Cells(nLastRowNum, Columns.Count).End(xlToLeft).Column
    
    '获取标题
    Dim titleRange As Range
    Set titleRange = Application.InputBox(prompt:="请选择标题区域：", Type:=8)
    
        
    ' 有效数据开始行
    Dim nRowValidData As Long
    nRowValidData = titleRange.Row + titleRange.Rows.Count


    ' 获取拆分列的信息,只需要列号
    Dim splitColumnRange As Range
    Set spl