一张总表秒变几百个分表，这代码匪夷所思得飞起来了

有一个工作簿，里面有一张总表，几千行数据。现在要求根据城市分成若干个分表，一个城市的数据单独存在一张分表里，若有50个城市就得分成50个分表。

这是总表，数据几千行。

这是拆分后的分表“上海”，数据只有100多行（订单数据里，上海的记录数就是100多行）。

一个总表按照城市分成多个分表，有些人是怎么完成这个操作的呢？都是通过一个一个的筛选后复制粘贴来完成的。这样操作，如果要拆分成几百个分表的话，真的需要1-2个小时。这种操作的效率显然比较低下，非常的low。

那么，如何高效解决这个问题呢，此处推荐用一段拆分的VBA代码来完成这个难题。

[1]- 在该工作簿里，按ALT+F11，进入vba编辑器，插入，模块

[2]- 在模块1里把下面代码复制粘贴过去

Sub 总表拆成分表()

    

    Dim time1 As Date, time2 As Date: time1 = Timer

    Dim data, d As Object, sh1 As Worksheet, sh2 As Worksheet

    

    Set dic = CreateObject('scripting.dictionary')

    Set sh1 = Sheets('订单数据')

    data = sh1.Range('A1').CurrentRegion

    

    For i = 1 To UBound(data)

        If Not dic.exists(data(i, 5)) Then '根据第5列的城市来拆分

            Set dic(data(i, 5)) = sh1.Range('A' & i).Resize(1, 6)  '总共有6列的数据

        Else

            Set dic(data(i, 5)) = Union(dic(data(i, 5)), sh1.Range('A' & i).Resize(1, 6))

        End If

    Next i

    

    x = dic.keys

    

    For k = 1 To UBound(x)

        Set sh2 = ActiveWorkbook.Sheets.Add(, after:=ActiveSheet)

        sh2.Name = x(k)

        dic.items()(k).Copy sh2.Range('A' & 2)

        sh1.Rows('1:1').Copy sh2.Range('A1')

        sh2.Cells.EntireColumn.AutoFit

        Range('a1').Select

    Next k

    time2 = Timer

    MsgBox Format(time2 - time1, '拆分已经完成，共耗时：0.00秒'), 64, '时间消耗统计'

    sh1.Select

End Sub

粘贴后的结果，截图如下

[3]- 关闭vba编辑器，然后开发工具，宏，选择'总表拆成分表'这个宏，执行，大概几秒或十几秒后，就完成了拆分。

---