指定某列字段，拆分总表为若干个分表存在当前工作簿里，只需要3秒！

有一个总表，有很多行数据，现在要根据姓名列，来拆分。同一个人的数据单独存放在一个分表里。

怎么拆？可以透视表拆，在我的课程里《Excel PPT Word小白变大神[500节]》里讲过的。课时195，ED027。

今天呢，我给大家分享一种VBA拆分法。代码照着搬过去就行了。

Sub 拆分成分表()

    

    Dim x As Long, y As Long

    Dim rng

    Dim d As Object

    

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    

    Set d = CreateObject('scripting.dictionary')

    

    With Worksheets('明细表')

        x = .Cells(.Rows.Count, 1).End(xlUp).Row

        c = .Cells(1, .Columns.Count).End(xlToLeft).Column

        rng = .Range('B1:B' & x)

        For y = 2 To UBound(rng)

            xm = CStr(rng(y, 1))

            If Not d.exists(xm) Then

                Set d(xm) = .Range('a1').Resize(1, c)

            End If

            Set d(xm) = Union(d(xm), .Cells(y, 1).Resize(1, c))

        Next

    End With

    

    For Each ll In d.keys

        On Error Resume Next

        Set sht = Worksheets(ll)

        If Err Then

            Set sht = Worksheets.Add(after:=Worksheets(Worksheets.Count))

            sht.Name = ll

        End If

        On Error GoTo 0

        With Worksheets(ll)

            .Cells.Clear

            d(ll).Copy .Range('A1')

        End With

    Next

    

End Sub

然后，开发工具，宏（也可以按alt f8）

选择这个宏“拆分成分表”，执行

结果很快出来了

拆分出来的结果截图

---