学习VBA，报表做到飞 第三章 字典 3.4 去除重复项与分类汇总

第三章 字典

3.4 去除重复项与分类汇总

由于字典的键具有唯一性，所以字典在去除重复项方面具有巨大的优势，且代码简洁，使用灵活。

在上一节《字典的属性》我们已经讲过，利用字典与数组搭配，很方便快捷的就把重复项去除了。

把需要去除重复项的内容读入数组：

arr = Range('a1:a100')

arr = Application.Transpose(arr)

然后利用字典的Item简化版属性，用For循环语句就会生成一个去除掉重复项的字典了：

For i = 1 To UBound(arr)

d(arr(i)) = ''

Next

利用字典的“键-值”对，以要统计的对象作为键，把要汇总的数值作为条目，就可以很轻松的实现分类汇总了。

小程序：

汇总各班级的成绩

班级	成绩
一班	15
一班	20
一班	35
二班	44
二班	28
二班	37
三班	66
三班	18
三班	99
四班	88
四班	89
四班	90
五班	91
五班	92
五班	93
六班	94
六班	95
六班	98

Sub 分类汇总()

Dim d As New Dictionary

arr = Range('a1').CurrentRegion

For i = 1 To UBound(arr)

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

Next

h = d.Count

Range('d1', Cells(h, 'd')) = Application.Transpose(d.Keys)

Range('e1', Cells(h, 'e')) = Application.Transpose(d.Items)

MsgBox '分类汇总成功！'

End Sub

在这个程序里，首先把数据读到arr数组里，形成如下图所示的数组：

我们还是利用了字典的Item简化版属性，用arr(i, 1)作为班级键值，arr(i, 2)作为待统计的数据。班级键值没有写入字典的，新增该班级键值和它对应的分数；班级键值已经存在的，则把循环到的分数累加到原来的条目上。最后把结果输出到D、E列。程序运行结果如下：

同样的，利用字典的“键-值”对，以要比较的对象作为键，把要比较的数值作为条目，就可以很轻松的实现取得每个对象的最大值、最小值了。

还是以上图为例，获取每个班级的最低分。

Sub 获取最小值()

Dim d As New Dictionary

arr = Range('a1').CurrentRegion

For i = 1 To UBound(arr)

If d.Exists(arr(i, 1)) Then

If d(arr(i, 1)) > arr(i, 2) Then

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

End If

Else

d.Add arr(i, 1), arr(i, 2)

End If

Next i

MsgBox Join(d.Keys)

MsgBox Join(d.Items)

End Sub

同样是利用了字典的Item简化版属性，只是多利用了字典的Exists属性，增加了一条判断班级键值是否在字典里存在的判断语句，因为字典的Item简化版属性会自动增加键值，但自动增加的对应条目为空，如果不用Add语句设置对应条目的第一个数值，会导致判断错误，最后得出的最小值全部为空。对班级键值对应的条目与循环到的数字相比较，留下最小值，最后把得到的结果用消息框弹出显示。