使用字典汇总数据

excelperfect

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