excel表格统计多个数据数量

Option Explicit
Sub abc()
　Dim r, d
　Set d = CreateObject("scripting.dictionary")
　For Each r In [a1].CurrentRegion
　　If Len(r.Value) Then d(r.Value) = d(r.Value) + 1
　Next
　[a1].Offset(, [a1].CurrentRegion.Columns.Count + 1).Resize(d.Count, 2) _
　　= Application.Transpose(Array(d.keys, d.items))
End Sub