专栏名称: Excel之家ExcelHome
excel技巧原创教程每日推送,excel表格职场模板干货仓库,图文/视频/动画等多种教学方式分享excel操作技巧教程/excel函数公式教程/excel数据透视表教程/excel图表教程/Word教程,助您轻松提高办公效率!
目录
相关文章推荐
完美Excel  ·  第一次 ·  昨天  
Excel之家ExcelHome  ·  新春快乐:用Excel制作一个奇趣万花筒 ·  3 天前  
Excel之家ExcelHome  ·  ExcelHome给您拜年啦! ·  昨天  
完美Excel  ·  几段操作工作簿的VBA代码 ·  4 天前  
完美Excel  ·  VBA:追踪工作簿打开和关闭信息 ·  4 天前  
51好读  ›  专栏  ›  Excel之家ExcelHome

【Excel VBA】字典+数组实现快速汇总

Excel之家ExcelHome  · 公众号  · Excel  · 2018-09-04 07:45

正文

前言

VBA开发者经常讨论的一个话题就是:字典和数组哪个效率更高?使得很多VBA初学者懵懂的认为,这两者非此即彼,水火不容。其实很多应用场景中,它们是并肩作战的好兄弟。


实例需求

已有生产排程数据如下所示。

需要整理为如下格式。

数据合并的要点有三个:

  • 料号和机种号为统计的关键字段

  • 未交数量求和

  • 交期汇总,包含时间和数量

示例代码

Sub LoadData()
    Dim aData, aRes(), lst, iRow, iCol, iKeyCol, Dic
    Const COLUMNS_QTY = 21
    With Sheets("交货排程")
        iKeyCol = 5
        lst = .Cells(.Rows.Count, iKeyCol).End(xlUp).Row
        aData = .Cells(2, 1).Resize(lst, COLUMNS_QTY).Value
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    For iRow = 3 To UBound(aData, 1)
        skey = aData(iRow, 5) & "|" & aData(iRow, 6)
        If Len(skey) > 1 Then
            If Dic.exists(skey) Then
                Dic(skey) = Array(Val(aData(iRow, 9)) + Dic(skey)(0), Dic(skey)(1))
            Else
                Dic(skey) = Array(Val(aData(iRow, 9)), "")
            End If
            For iCol = 11 To UBound(aData, 2)
                If Val(aData(iRow, iCol)) > 0 Then
                    sdate = VBA.Replace(Format(aData(2, iCol), "m-d"), "-", "/")
                    Debug.Print Dic(skey)(1) & "," & sdate & "*" & aData(iRow, iCol)
                    Dic(skey) = Array(Dic(skey)(0), Dic(skey)(1) & "," & sdate & "*" & aData(iRow, iCol))
                End If
            Next iCol
        End If
    Next iRow
    ReDim aRes(1 To Dic.Count, 1 To 4)
    n = 1
    For Each d In Dic.keys
        akey = Split(d, "|")
        aRes(n, 1) = akey(0)
        aRes(n, 2) = akey(1)
        aRes(n, 3) = Dic(d)(0)
        aRes(n, 4) = Mid(Dic(d)(1), 2)
        n = n + 1
    Next
    ' 结果数组aRes回写到工作表中
    With Sheets("结果")
        .Range("2:10000").ClearContents
        .Cells(2, 1).Resize(Dic.Count, 4).Value = aRes
        .Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
    End With
    Set Dic = Nothing
End Sub

代码解析

对于需要进行排重统计的应用,使用数组就可以实现,对于每个数据行都需要循环对比数组的全部元素,然而字典对象元素具有唯一性,因此对于排重统计有着独到的优势。 

对于每个关键字段组合,需要保存的信息有:两个关键字段,数量和相应的日期,此时数组就可以方便保存多个数据。因此使用字典和数组组合的双剑合璧,功力无敌! 

将工作表数据加载到数组的代码,不需要多讲。

aData = .Cells(2, 1).Resize(lst, COLUMNS_QTY).Value

将关键字段进行组合,确定字典的键值。

skey = aData(iRow, 5) & "|" & aData(iRow, 6

下面代码将一个 1 x 2的数组保存在字典对象中,如果skey是一个新的键值,那么将未交数量aData(iRow, 9)做为数组第一个元素,第二元素暂时留空。 

如果skey是一个在字典中已经存在的键值,那么Val(aData(iRow, 9)) + Dic(skey)(0)将未交数量进行累加,并保留已有的交期信息Val(aData(iRow, 9)) + Dic(skey)(0)

If Dic.exists(skey) Then
    Dic(skey) = Array(Val(aData(iRow, 9)) + Dic(skey)(0), Dic(skey)(1))
Else
    Dic(skey) = Array(Val(aData(iRow, 9)), "")
End I

与此类似,下面代码将汇总交期信息。注意更新字段对象的数组元素时,只能全部重新赋值,而不能使用Dic(skey)(0)="xxx"的形式

For iCol = 11 To UBound(aData, 2)
    If Val(aData(iRow, iCol)) > 0 Then
        sdate = VBA.Replace(Format(aData(2, iCol), "m-d"), "-", "/")
        Debug.Print Dic(skey)(1) & "," & sdate & "*" & aData(iRow, iCol)
        Dic(skey) = Array(Dic(skey)(0), Dic(skey)(1) & "," & sdate & "*" & aData(iRow, iCol))
    End If
Next iCol

对于字典中保存的数组元素,无法直接回写到工作表中,因此需要先构建回写的二维数组。Mid(Dic(d)(1), 2)用于去掉交期信息中的第一个逗号。

    For Each d In Dic.keys
        akey = Split(d, "|")
        aRes(n, 1) = akey(0)
        aRes(n, 2) = akey(1)
        aRes(n, 3) = Dic(d)(0)
        aRes(n, 4) = Mid(Dic(d)(1), 2)
        n = n + 1
    Next

后记

对于这个实例,只用数组可以实现吗?肯定可以实现,而且在数据量不大的情况下,效率差距也不大。不是只用保存数组的字典对象,而使用字典对象嵌套也可以实现。条条大路通罗马,希望大家能够灵活运用字典和数组组合。


图文作者:taller

ExcelHome论坛版主

推荐文章
完美Excel  ·  第一次
昨天
Excel之家ExcelHome  ·  新春快乐:用Excel制作一个奇趣万花筒
3 天前
Excel之家ExcelHome  ·  ExcelHome给您拜年啦!
昨天
完美Excel  ·  几段操作工作簿的VBA代码
4 天前
完美Excel  ·  VBA:追踪工作簿打开和关闭信息
4 天前