按某个字段拆分工作表 | 祝新年快乐！

下图sheet1中的数据是数据源，记录的是不同地区不同品牌手机的销售数量。现在的要求是按品牌这一列拆分工作表，将相同品牌的数据放在同一工作表中。结果如动图所示。

我是用vba代码来做的这个效果。代码如下，左右滑动查看。

Sub 按品牌拆分工作表() Dim arr, brr(), i%, j%, n%, pp Dim newsht As Worksheet, d As Object Application.ScreenUpdating = False Set d = CreateObject("scripting.dictionary") arr = Range("a1").CurrentRegion For i = 2 To UBound(arr) d(arr(i, 4)) = "" Next i For Each pp In d.keys For i = 2 To UBound(arr) If arr(i, 4) = pp Then n = n + 1 ReDim Preserve brr(1 To UBound(arr, 2), 1 To n) For j = 1 To UBound(arr, 2) brr(j, n) = arr(i, j) Next j End If Next i Set newsht = Worksheets.Add(after:=Worksheets(Worksheets.Count)) With newsht .Name = pp .[a1].Resize(1, UBound(arr, 2)) = Application.Index(arr, 1) .[a2].Resize(n, UBound(arr, 2)) = Application.Transpose(brr) Sheet1.UsedRange.Copy .UsedRange.PasteSpecial xlPasteFormats End With n = 0 Next pp Application.CutCopyMode = False Application.ScreenUpdating = True Set d = NothingEnd Sub

代码的思路大致如下：

先将品牌这一列的数据通过循环的方式装入字典中，这样就在字典的关键字中得到了不重复的品牌。

然后循环遍历每个不重复的品牌，每循环一个不重复的品牌，就新建一个工作表，并将表名改为此品牌。再用此品牌和数据源中的每个品牌依次比较，如果二者相等，就将数据源中的相应记录装入数组中。等和数据源中的所有品牌比较完后，就把数组中收集的相应数据输出到新建并改名后的工作表中。

最后，祝春节快乐！身体健康心里自在！

文件链接：

https://pan.baidu.com/s/1P42HLS8j4VlaUynf7XHuAg

提取码：do3q