标签: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社群下载示例工作簿。