如上图所示,要求:
1、用代码为左表中单元格赋值。(说明:以下相应的代码只是为了记录相关的使用方法,实际应用中并不需要这么麻烦。)
2、把左表中不重复的姓名统计到右表中,重复人员籍贯按后出现的籍贯为准,统计每个姓名出现的次数,以及每人累计销售量。
代码如下:
Private Sub CommandButton1_Click()
[A:H].ClearContents 'Dim d1 As Object, d2 As Object, d3 As Object, k, t '逐个定义字典对象 Dim dic(1 To 3) As Object, k, t '多个字典对象可定义为数组 'Set d1 = CreateObject("scripting.dictionary") Set dic(1) = CreateObject("scripting.dictionary") Set dic(2) = CreateObject("scripting.dictionary") Set dic(3) = CreateObject("scripting.dictionary") dic(1).Add "xm1", "jg1" dic(1).Add "xm2", "jg2" dic(1).Add "xm3", "jg3" 'dic(1).Item("xm3") = "jg100" '把关键字xm3的项改为“jg100” 'If dic(1).exists("xm3") Then ' MsgBox "指定的关键字xm3存在。" 'End If k = dic(1).keys '把字典对象dic(1)中的关键字赋给变量k t = dic(1).items '把字典对象dic(1)中的项赋给变量t '加标题行内容 [A1].Resize(1, 8) = Array("姓名(有重复)", "籍贯", "销售", "", "姓名(无重复)", "籍贯", "同一姓名出现次数", "销售总量") '把变量k、t分别赋给A2和B2单元格开始的列中(需转置) [A2].Resize(dic(1).Count, 1) = Application.Transpose(k) [B2].Resize(dic(1).Count, 1) = Application.Transpose(t) 'A5开始的5行2列单元格区域用数组公式赋值 [A5].Resize(5, 2).FormulaArray = _ "={""xm4"",""jg4"";""xm2"",""jg5"";""xm6"",""jg6"";""xm1"",""jg7"";""xm8"",""jg8""}" '“销售”列赋值 [C2].Resize(8, 1).FormulaArray = _ "={100;200;300;400;500;600;700;800}" Dim iRow As Long, i As Long, Arr iRow = Sheet1.[A65536].End(xlUp).Row Arr = Sheet1.Range("A1:C" & iRow) '从第5行开始,把关键字“姓名”加入字典(因为第5行开始的5行2列数据是用数组公式赋值的,关键字中不一定有)。 '如果关键字中没有该“姓名”,则把该“姓名”和“籍贯”加入关键字和项中; '如果关键字中已有该“姓名”,则相应的项取其最后一次出现的“籍贯” For i = 5 To UBound(Arr) dic(1)(Arr(i, 1)) = Cells(i, 2) Next '计数,求和 For i = 2 To UBound(Arr) '因为有标题行,所以从第2行开始 dic(2)(Arr(i, 1)) = dic(2)(Arr(i, 1)) + 1 '计数,统计关键字“姓名”出现的次数。关键字“姓名”每出现一次,其项加1 dic(3)(Arr(i, 1)) = dic(3)(Arr(i, 1)) + Arr(i, 3) '求和,累计“销售”的总量。关键字“姓名”每出现一次,把“销售”累加进项中 'dic(4)(Arr(i, 1) & "|" & Arr(i, 3)) = i '保留行号 Next '-------------------------------------------------------------------------------------------------------------------------------- '先用字典求得符合条件的行号,再通过行号显示整行数据 '================================================================================================================================ '如果符合条件的行号已经保存到字典对象dic(4)的项中,假如现在要把原表中符合条件的3列数据显示在J2:L2向下的区域中, 'Dim Rng As Range '[J:L].ClearContents '[J2].Resize(dic(4).Count, 1) = Application.Transpose(dic(4).items) '因为项中保存的是符合条件的行号 ' '本行代码即:先把符合条件的行号赋给J2开始的列中 'For Each Rng In [J2].Resize(dic(4).Count, 1) ' 'Cells(Rng, 1)中作为参数的Rng=Rng.Value,而Rng.Resize(1, 3)处的Rng是一个单元格对象。 ' Rng.Resize(1, 3) = Cells(Rng, 1).Resize(1, 3).Value 'Next '-------------------------------------------------------------------------------------------------------------------------------- [E2].Resize(dic(1).Count, 1) = Application.Transpose(dic(1).keys) [F2].Resize(dic(1).Count, 1) = Application.Transpose(dic(1).items) [G2].Resize(dic(2).Count, 1) = Application.Transpose(dic(2).items) [H2].Resize(dic(3).Count, 1) = Application.Transpose(dic(3).items) '释放字典内存 Set dic(1) = Nothing Set dic(2) = Nothing Set dic(3) = Nothing End Sub
|