 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先將品牌這一列的數(shù)據(jù)通過循環(huán)的方式裝入字典中，這樣就在字典的關(guān)鍵字中得到了不重復(fù)的品牌。 https://pan.baidu.com/s/1P42HLS8j4VlaUynf7XHuAg |
|
|
