使用字典汇总数据
标签：VBA，Dictionary对象
以一个简单的数据集为例，通过唯一的标识符对其进行汇总。如果我们有一个水果店，想按售出的商品汇总销售额。如下图1所示。
图1
水果的汇总如下图2所示，使用字典生成这个简单的汇总。这是展示的第一种方法：根据唯一条件生成一个求和，而这里唯一的部分是水果的名称。
图2
代码如下：
Sub SumIt()
Dim ar
Dim i As Long
Dim arr As Variant
Dim n As Long
ar = [a1].CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ar, 1)
.Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 6)
Next
arr = Array(.keys, .items)
n = .Count
End With
[T4].CurrentRegion.ClearContents
[T4].Resize(n, 2).Value = Application.Transpose(arr)
End Sub上述代码有效的原因是字典将只包含唯一的项。水果是唯一的，所以每个项目都会依次评估和汇总。
.Item(ar(i, 1)) = .Item(ar(i, 1)) + ar(i, 6)
上面一行末尾的6表示示例数据集中的第6列（总和），可以将6更改为与数据相关的列。
此外，当前项目值将与列表中的下一个相似值相加。循环完成后，字典的全部内容将赋给变量arr。
arr = Array(.keys, .items)
现在需要做的就是定义一个空间来放置数组（arr）的内容。
[T4].Resize(n, 2).Value = Application.Transpose(arr)
其中，n是数组的长度，2是宽度（两列的水果和我们对其放置的值）。
第二种方法是，生成汇总但包含表中的每一个唯一行，如下图3所示。
图3
上图3中每个项目有更多详细信息，可以看到汇总中包含了更多的细节。这次在列O和列P中进行汇总。
代码如下：
Sub SumMultiple()
Dim ar As Variant
Dim i As Long
Dim j As Long
Dim n As Long
Dim str As String
n = 1
ar = Cells(10, 1).CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = 2 To UBound(ar, 1)
str = ar(i, 1)
If Not .Exists(str) Then
n = n + 1
For j = 1 To UBound(ar, 2)
ar(n, j) = ar(i, j)
Next
.Item(str) = n
Else
For j = 5 To UBound(ar, 2)
ar(.Item(str), j) = ar(.Item(str), j) + ar(i, j)
Next
End If
Next
End With
[K4].CurrentRegion.ClearContents
[K4].Resize(n, UBound(ar, 2)).Value = ar
End Sub代码的关键是：
For j = 5 To UBound(ar, 2)
ar(.Item(str), j) = ar(.Item(str), j) + ar(i, j)
Next
要求和的列从第5列（E）开始，并转到需要求和的列的末尾（在本例中是）6。现在，如果数据集更大，比如说有10列求和，它将依次对这些列求和，上面的循环从第5列开始，对所有类似的项求和，然后在第14列结束。这非常有效，而且很容易适应需要。你也会惊讶地发现，即使扩展到数千行的数据集，它的运行速度也很快。
注：本文学习整理自thesmallman.com，有兴趣的朋友可以到该网站下载示例工作簿，也可以到知识星球App完美Excel社群下载示例工作簿。
腾讯云开发者
