VBA实现excel数据-拆分到表(优化版)

最新推荐文章于 2022-07-02 17:09:34 发布

转载最新推荐文章于 2022-07-02 17:09:34 发布 · 347 阅读

1 ·

CC 4.0 BY-SA版权

原文链接：http://www.cnblogs.com/joewancn/p/9643712.html

本文介绍了一种使用VBA进行Excel表拆分的优化方法，通过先清空非主表并按列值（表名）拆分，避免了数据重复。详细展示了如何用VBA代码实现这一过程，包括新建工作表、复制表头和数据等关键步骤。

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

Sub 表拆分优化版() '先清空非主表,再拆分,防止拆分后数据重复
    
    Dim imaxRow As Integer, ssName As String, sht As Object, n As Integer, x As Integer
    Application.DisplayAlerts = False
    
    For x = Worksheets.Count To 1 Step -1
        If Worksheets(x).Name = "数据" Then Exit For  '遇到worksheets("数据")就停止
        Worksheets(x).Delete
        
    Next
    
    Application.DisplayAlerts = True
    
    imaxRow = Worksheets("数据").Range("A1").End(xlDown).Row '表的最大行
    
    
    For x = 2 To imaxRow
    
        ssName = Worksheets("数据").Range("C" & x).Value ' 获取列值,即表名
    
        On Error Resume Next '以下程序就算出错也继续运行
        
        Set sht = Worksheets(ssName)  '①
        
        If Err.Number <> 0 Then  '判断表名不存在时, 0 代表存在
            '新建表
            Set sht = Worksheets.Add(, Worksheets("数据"))    '疑惑:②, 此时的表明与①表名并不同
            sht.Name = ssName
            '填写表头
            Worksheets(ssName).Range("A1").Resize(1, 8).Value = _
            Worksheets("数据").Range("A1").Resize(1, 8).Value
    
        End If
            '填数据
            n = sht.Range("A" & Rows.Count).End(xlUp).Row + 1  '获取当前worksheets的行数
            Worksheets(ssName).Range("A" & n).Resize(1, 8).Value = _
            Worksheets("数据").Range("A" & x).Resize(1, 8).Value
    
       Next
End Sub

转载于:https://www.cnblogs.com/joewancn/p/9643712.html