前面做了一次投票，发现很多同学对VBA高兴趣，

所以我们今天来写一篇VBA相关的实战话题
按字段拆分，可能很多新手不能理解字段，通俗点讲，可以理解为按标题，

比如姓名、商品名称等等
网路上关于拆分的VBA代码非常多

今天我们要分享的，目前网络上应该还没有，也算是今天偶然的一个思路吧

一般思路有：

1、高级筛选法-使用较少，数据量不大，还是一种不错的思路

2、容错复制粘贴法- 多次粘贴，导致效率低下

3、数组+循环 - 需要多次遍历整个数据源

新思路是：字典+Union 一次粘贴。
Data:日常销售表

执行效果：

代码非常简洁：

源码分享：如何使用代码：番外篇-EXCEL如何使用宏（VBA）

'功能：按字段拆分到工作表
'日期：2020年4月5日
'作者：Excel办公实战-小易
Sub SplitDataToSht()
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    '获取要拆分的数据源
    Dim arr
    arr = Sheet1.Range("a1").CurrentRegion.Value
    
    '字典+Union 一次循环分组
    Dim i As Long, curRang As Range, titleRng As Range
    For i = 2 To UBound(arr)
        '当前行数据
        Set curRang = Sheet1.Cells(i, 1).Resize(1, UBound(arr, 2))
        If Not d.exists(arr(i, 1)) Then
            Set titleRng = Sheet1.Cells(1, 1).Resize(1, UBound(arr, 2))
            '首次把标题行及对应数据加入
            Set d(arr(i, 1)) = Union(titleRng, curRang)
        Else
            '否则，把当前和前面满足条件的拼接起来
            Set d(arr(i, 1)) = Union(d(arr(i, 1)), curRang)
        End If
    Next
    
    '创建工作表并写入数据
    For i = 1 To d.Count
        Sheets.Add after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = d.keys()(i - 1)
            d.items()(i - 1).Copy .Range("a1")
        End With
    Next
    MsgBox "拆分完成！共" & d.Count & "个大类"
End Sub

小结： 按字段拆分，也是工作表中比较常见的需求了，除了今天我们总结的新思路还有透视表也可以解决这个问题，不过如果操作频繁，还是推荐VBA处理，基本形成模板，一键拆分

Excel办公实战，高效办公，每天进步一点点！