字典：比较典型的应用

FIFAWORLDCUP

来源与蓝版：http://club.excelhome.net/thread-868892-1-2.html
1.统计重复出现的次数
Sub cfz()
    Dim i&, Myr&, Arr
    Dim d, k, t, n
    n = ActiveSheet.Cells.Rows.Count
    Set d = CreateObject("Scripting.Dictionary")
    Myr = Sheet1.Cells(n, 1).End(xlUp).Row
    Arr = Sheet1.Range("a1:a" & Myr)
   
        For i = 2 To UBound(Arr)
            d(Arr(i, 1)) = d(Arr(i, 1)) + 1
        Next
        
    k = d.keys
    t = d.items
   
    Sheet2.Activate
    [a2].Resize(d.Count, 1) = Application.Transpose(k)
    [b2].Resize(d.Count, 1) = Application.Transpose(t)
    [a1].Resize(1, 2) = Array("姓名", "重复个数")
    Set d = Nothing
End Sub

FIFAWORLDCUP

如果使用以上代码去除重复数据，可以：
d(Arr(i, 1)) = d(Arr(i, 1)) + 1    用于统计出现次数，

去重     d(Arr(i, 1)) =“”      即可

FIFAWORLDCUP

疑问：
使用d(Arr(i, 1)) = d(Arr(i, 1)) + 1用于统计出现次数时
d(Arr(i, 1)) 的初始值是1，还是0？
原因是什么？为什么不需要设置d(Arr(i, 1)) 它的初始值？
@蓝桥玄霜

caffish

FIFAWORLDCUP 发表于 2020-7-29 08:26
疑问：
使用d(Arr(i, 1)) = d(Arr(i, 1)) + 1用于统计出现次数时
d(Arr(i, 1)) 的初始值是1，还是0？

装入字典之前的时候d(arr(i,1))是没有值的，所以d(arr(i,1))=0+1表明arr(i,1)此时第一次装入字典，值为1，如果有重复值，此时d(arr(i,1))再次赋值，在上一次存储的值上再加1，d(arr(i,1))就变成2了。如果要赋初始值的话需要加一个If判定，如果arr(i,1)是第一次出现，就赋值为1，如果再出现，每出现一次加1，代码就显得臃肿了
if not d.exists(arr(i,1)）then
d(arr(i,1))=1
else
d(arr(i,1))=d(arr(i,1))+1
end if

FIFAWORLDCUP

Option Explicit

Sub quc()
Dim i%, j%, d As Object, n&, arr, k, t, sh As Worksheet, m
n = ActiveSheet.Cells.Rows.Count
m = ActiveSheet.Cells(n, 1).End(3).Row

Set d = CreateObject("scripting.dictionary")

arr = Sheet1.Range("a1:a" & m)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
Next

k = d.keys
t = d.items

Set sh = Worksheets.Add
sh.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)

[a1].Resize(1, 2) = Array("name", "times")

Set d = Nothing
   
End Sub

FIFAWORLDCUP

Option Explicit

Sub quc()
Dim i%, j%, d As Object, n&, arr, k, t, sh As Worksheet, m

m = ActiveSheet.Cells(ActiveSheet.Cells.Rows.Count, 1).End(3).Row

Set d = CreateObject("scripting.dictionary")

arr = Sheet1.Range("a1:a" & m)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) + 1
Next

k = d.keys
t = d.items

Set sh = Worksheets.Add
sh.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)

[a1].Resize(1, 2) = Array("name", "times")

Set d = Nothing
   
End Sub