|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 方法5()
Dim d, K, t
With ActiveSheet
Set d = CreateObject("Scripting.Dictionary")
K = Range("A65536").End(xlUp).Row
arr = Range("a1:a" & K)
For i = 1 To K
d(arr(i, 1)) = d(arr(i, 1)) + 1
Cells(i, 2) = d(arr(i, 1))
Next
K = d.Keys
t = d.items
.Cells(1, 3).Resize(d.Count, 1).clear
.Cells(1, 4).Resize(d.Count, 1).clear
.Cells(1, 2).Resize(d.Count, 1).Interior.Color = RGB(255, 255, 0)
.Cells(1, 3).Resize(d.Count, 1).Interior.ColorIndex = 7
.Cells(1, 2).Resize(d.Count, 1).NumberFormatLocal = "@"
.Cells(1, 3).Resize(d.Count, 1).NumberFormatLocal = "@"
.Cells(1, 3).Resize(d.Count, 1) = Application.Transpose(K)
.Cells(1, 4).Resize(d.Count, 1) = Application.Transpose(t)
End With
Set d = Nothing
End Sub
|
|