|
- Sub yy()
- Dim Arr, i&, r%, Arr1()
- Dim d, k, t
- Set d = CreateObject("Scripting.Dictionary")
- Sheet1.Activate
- Arr = [a10].CurrentRegion
- For i = 1 To UBound(Arr)
- d(Arr(i, 1)) = d(Arr(i, 1)) + 1
- Next
- k = d.keys
- t = d.items
- For i = 0 To UBound(k)
- If t(i) >= 2 And t(i) <= 5 Then
- r = r + 1
- ReDim Preserve Arr1(1 To r)
- Arr1(r) = k(i)
- End If
- Next
- Columns("b:b").NumberFormatLocal = "@"
- [b10].Resize(r) = Application.Transpose(Arr1)
- End Sub
复制代码 |
|