Sub range装进字典() Dim i, j, k Dim ar, tmp() Dim d AsObject, kw$ Set d = CreateObject("Scripting.Dictionary") 'd.CompareMode = vbTextCompare '不区分大小写
ar = Range("a1:e" & [a65536].End(3).Row) Dim irow For i = 2To UBound(ar) kw = ar(i, 4) IfNot d.exists(kw) Then Set d(kw) = Union(Range("a1:e1"), Range("a" & i & ":e" & i)) Else Set d(kw) = Union(d(kw), Range("a" & i & ":e" & i)) EndIf Next i
Dim dk ForEach dk In d.keys With ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)) .Name = dk d(dk).Copy .[a1] EndWith Next