|
- Sub Macro1()
- Dim arr, d, i&, s&, zf$
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- For i = 1 To UBound(arr)
- zf = Join(Application.Index(arr, i, 0), " ")
- d(zf) = d(zf) + 1
- Next
- a = d.keys: b = d.items
- For i = 0 To d.Count - 1
- If b(i) >= 4 Then
- s = s + 1
- x = Split(a(i))
- Cells(s, "k").Resize(1, UBound(x) + 1) = x
- End If
- Next
- With [k1].Resize(s, UBound(arr, 2))
- .Value = .Value
- End With
- End Sub
复制代码 |
|