VBA入门61：字典计数

VBA中字典常常用来进行计数。

练习1：水果计数。

代码：

Sub vc()

    Dim arr, d As Object

    arr = [a1:a10]

    Set d = CreateObject('scripting.dictionary')

    For i = 1 To 10

    '对水果进行计数

        d(arr(i, 1)) = d(arr(i, 1)) 1

    Next

    '输出结果

    [c1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))

End Sub

理解--d(arr(i, 1)) = d(arr(i, 1)) 1

在平常代码中，假设n=0，执行代码n=n 1后，n=1；再执行代码n=n 1，n=2.......这是VBA中的累加（计）算法。d(arr(i, 1)) = d(arr(i, 1)) 1同样的道理，初始是0，运行代码d(arr(i, 1)) = d(arr(i, 1)) 1后，d(arr(i, 1))=1。

因为字典的特性，所以每种水果都能(分类)分别进行累计的运算。

---

练习2：去重复计数,求每种水果的单价分别有几种，重复的单价算一个。

思路：将水果和单价合并，作为唯一值，放进字典的key。对数据进行去重复处理。如黄色数据“苹果，3”，只保留一条。然后再进行计数。

代码：

Sub vv()

    Dim arr, d As Object

    arr = [a1:b10]

    Set d = CreateObject('scripting.dictionary')

    For i = 1 To 10

        '多字段合并为唯一值,用做字典的key

        okey = arr(i, 1) & arr(i, 2)

        '对数组数据进行取重复处理

        '如果关键字不存在

        If Not d.exists(okey) Then

            '将关键字放进字典

            d(okey) = ''

            k = k 1 '计数

            '提取数据

            arr(k, 1) = arr(i, 1)

            arr(k, 2) = arr(i, 2)

        End If

    Next

    d.RemoveAll '清空字典

    For i = 1 To k '再用字典计数

        d(arr(i, 1)) = d(arr(i, 1)) 1

    Next

    '输出结果

    [d1].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))

End Sub

字典在代码中，不单单只能用一个，还可以用2个或更多，当然，字典是对象，数量多了，就会导致代码效率低。

将上述问题用两个字典来处理，代码如下：

Sub 双子()

    Dim arr, d As Object, dd As Object

    arr = [a1:b10]

    Set d = CreateObject('scripting.dictionary') '第一个字典

    Set dd = CreateObject('scripting.dictionary') '第二个字典

    For i = 1 To 10

    '合并字段用作字典关键字key,判断是否重复

        okey = arr(i, 1) & arr(i, 2)

        If Not d.exists(okey) Then

        '第一个字典用来判断是否重复,不重复才计数

            d(okey) = ''

        '第二个字典用来进行计数

            dd(arr(i, 1)) = dd(arr(i, 1)) 1

        End If

    Next

    '输出数据（计数的字典）

    [d1].Resize(dd.Count, 2) = Application.Transpose(Array(dd.keys, dd.items))

End Sub