- Sub test()
- Set d = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- With Sheets("英超")
- arr = .UsedRange
- For j = 3 To UBound(arr)
- Str1 = Replace(Split(arr(j, 3), "]")(1), " ", "")
- If d.Exists(Str1) Then
- Set d(Str1) = Union(d(Str1), .Cells(j, 1).Resize(1, 12))
- Else
- Set d(Str1) = Union(.Cells(1, 1).Resize(2, 12), .Cells(j, 1).Resize(1, 12))
- End If
- str2 = Replace(Split(arr(j, 5), "[")(0), " ", "")
- If d.Exists(str2) Then
- Set d(str2) = Union(d(str2), .Cells(j, 1).Resize(1, 12))
- Else
- Set d(str2) = Union(.Cells(1, 1).Resize(2, 12), .Cells(j, 1).Resize(1, 12))
- End If
- Next j
- End With
- For j = 0 To d.Count - 1
- d.Items()(j).Copy Sheets(d.Keys()(j)).[a1]
- Next j
- Application.ScreenUpdating = True
- End Sub
复制代码 |