excel vba 怎麽對去重後的數據進行個數統計？

測試數據：

程序代碼：

執行效果：

代碼文本：

Option Explicit

Sub 提重統計()

Dim arr, db, i&, k, v

Set db = CreateObject("Scripting.Dictionary")

arr = Range("a1").CurrentRegion

For i = 2 To UBound(arr)

v = Trim(arr(i, 1))

k = Trim(arr(i, 2))

If Not db.Exists(k) Then db.Add k, CreateObject("Scripting.Dictionary")

db(k)(v) = True

Next i

ReDim arr(1 To db.Count, 1 To 2)

i = 0

For Each k In db.Keys

v = db(k).Count

i = i + 1

arr(i, 1) = k

arr(i, 2) = v

Next k

Range("d3").Resize(i, 2) = arr

End Sub