使用字典汇总数据（续）

发布于

标签：VBA，Dictionary对象

在学习了《使用字典汇总数据》后，让我们再往前一步。假设我们的数据需要在多个列上进行检查。将A列中的数据链接到B列中的数据，以创建唯一标识符，希望基于2列创建汇总，而不只是前一个示例中所示的一个。假设供应商是Bob，Bob订购了Apple和Orange。订单分为6个不同行，但不是Apple就是Orange。

假设需要根据供应商Bob和水果Apple或Orange汇总数据。如果Bob买了一种不同的水果，那么我们希望代码更加灵活，这样它就能捕获并记录数据。

图1

实现该任务的VBA代码如下所示，并且很容易更改以满足你的需要。

代码语言：javascript
复制
Sub SumJoinCol()
    Dim rng As Range
    Dim r As Range
    Dim i As Integer
    Dim j As Long
    Dim n As Long
    Dim txt As String
    Dim ar As Variant
    Dim arr As Variant
    Set rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
    ar = [a1].CurrentRegion
    With CreateObject("scripting.dictionary")
        For Each r In rng
        '开始的2列
            txt = Join(Application.Transpose(Application.Transpose(r.Resize(, 2))), ",")
            If Not .Exists(txt) Then
                n = n + 1
                .Add txt, n
                '列数
                For j = 1 To UBound(ar, 2)
                     ar(n, j) = r.Offset(, j - 1)
                Next j
            Else
            '计算列开始(本例中是第6列)
                For i = 6 To UBound(ar, 2)
                    ar(.Item(txt), i) = ar(.Item(txt), i) + r.Offset(, i - 1)
                Next i
            End If
        Next
        Sheet3.[a1].Resize(n, UBound(ar, 2)) = ar
    End With
End Sub

代码运行后得到的汇总报告如下图2所示，正是我们想要的结果。

图2

上面的秘密是，使用VBA的Join方法将数据组合。在前两列之间创建文本连接：

txt = Join(Application.Transpose(Application.Transpose(r.Resize(, 2))), ",")

这允许将列连接起来，从而在列A和列B之间创建唯一标识符。

BobApple

BobOrange

键必须是唯一的，以便将第6列和第7列中的所有BobApple和BobOrange对应的数值相加。

For i = 6 To UBound(ar, 2)

在上述情况下，该指令用于循环从第6列开始，并转到数组中的最后一列，即第7列。如果数据较大，则上面的操作将会处理，你只需要保证开始列的硬编码正确。

如果想扩展过程以覆盖3列或更多列的连接，那么对于3列，代码将如下所示：

txt = Join(Application.Transpose(Application.Transpose(r.Resize(, 3))), ",")

这里，前3列被连接以创建唯一标识符。

注：本文学习整理自thesmallman.com，有兴趣的朋友可以到该网站下载示例工作簿，也可以到知识星球App完美Excel社群下载示例工作簿。

#vba#jquery