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

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