|
发表于 2014-10-18 10:53
|
显示全部楼层
本楼为最佳答案
- Sub Macro1()
- Dim w(9), rng As Range, d, i%, n&, n2&
- Set rng = Selection
- Set d = CreateObject("scripting.dictionary")
- [x1:y10].ClearContents
- If Not Application.Intersect(Range("b388").CurrentRegion, rng) Is Nothing Then
- For i = rng.Count To 1 Step -1
- s = rng(i).Value
- If Not d.exists(s) Then d(s) = d(s) + 1: w(s) = s
- If d.Count > 4 Then Exit For
- Next
- For i = 0 To 9
- If w(i) <> "" Then n = n + 1: Cells(n, "x") = w(i)
- If Not d.exists(i) Then n2 = n2 + 1: Cells(n2, "y") = i
- Next
- End If
- End Sub
复制代码 |
|