【原】【VBA实战系列】004-新思路，一次循环解决按字段拆分问题

前面做了一次投票，发现很多同学对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办公实战，高效办公，每天进步亿点点！