前往小程序,Get更优阅读体验!
立即前往
首页
学习
活动
专区
工具
TVP
发布
社区首页 >专栏 >使用字典汇总数据(续)

使用字典汇总数据(续)

作者头像
fanjy
发布2022-11-16 10:40:39
5070
发布2022-11-16 10:40:39
举报
文章被收录于专栏:完美Excel

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

本文参与 腾讯云自媒体同步曝光计划,分享自微信公众号。
原始发表:2022-06-24,如有侵权请联系 cloudcommunity@tencent.com 删除

本文分享自 完美Excel 微信公众号,前往查看

如有侵权,请联系 cloudcommunity@tencent.com 删除。

本文参与 腾讯云自媒体同步曝光计划  ,欢迎热爱写作的你一起参与!

评论
登录后参与评论
0 条评论
热度
最新
推荐阅读
领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档