大家好,我们今天继续讲解VBA数组与字典解决方案,今日的内容是第38讲,利用数组与字典,实现单个条件的数据汇总求和。在VBA解决方案的丛书中,这套VBA数组与字典解决方案是专门讲解数组和字典的。这套书的开始先讲了EXCEL数组的利用,然后又讲了VBA数组,从上一讲开始,我们开始讲字典。讲了什么是字典,及其简单的应用,从这讲开始,我们开始讲数组和字典的各种实际利用方法,这些方案是我将多年的经验加以整理而成,如果你有机会能看到这些,希望对你有所帮助。
今日的内容是利用数组与字典,实现单个条件汇总求和,我们看下面的数据:
我们要实现按A列的数据汇总求和,看看我们可以怎么实现,由于这是我的第三套书,大家可以想想,这个内容在我的第一套书《VBA代码解决方案》和第二套书《VBA数据库解决方案》中如何实现呢?下面看看我给出的代码:
SubMyNZsz_38()第38讲应用数组与字典,实现单个条件汇总求和
Dimmyarr
将数据放入数组中
Sheets(38).Select
myarr=Range(a2:bRange(b2).End(xlDown).row)
定义字典
SetmyDic=CreateObject(Scripting.Dictionary)
给字典赋值
Fori=1ToUBound(myarr,1)
IfNotmyDic.exists(myarr(i,1))Then
没有找到键,那么就赋值
myDic(myarr(i,1))=myarr(i,2)
Else
找到,值增加
myDic(myarr(i,1))=myDic(myarr(i,1))+myarr(i,2)
EndIf
Next
Range(g:h).ClearContents
Range(g1:h1)=Array(型号,数量)
将键和键值赋给数组,并通过装置函数显示在工作表中
myarr=Array(myDic.Keys,myDic.items)
Range(g2).Resize(myDic.Count,2)=Application.Transpose(myarr)
EndSub
代码截图:
代码解析:
1上述代码实现了按A列的值,把B列数据汇总的功能。
2myarr=Range(a2:bRange(b2).End(xlDown).row)
上述语句将数据放到数组中,注意这里的myarr是个二维数组
3SetmyDic=CreateObject(Scripting.Dictionary)
上述语句定义了一个字典
4IfNotmyDic.exists(myarr(i,1))Then
没有找到键,那么就赋值
myDic(myarr(i,1))=myarr(i,2)
Else
找到,值增加
myDic(myarr(i,1))=myDic(myarr(i,1))+myarr(i,2)
EndIf
上述语句实现了首先查找,根据查找的结果做后续处理的方式。查找到了汇总求和,没有找到就新增条目。
5myarr=Array(myDic.Keys,myDic.items)
上述语句赋给数组,仍是一个二维的数组
6Range(g2).Resize(myDic.Count,2)=Application.Transpose(myarr)
上述语句将数组放到工作表中。注意要首先将工作表的区域扩展到和数组一般的大小。
下面看代码的运行:
今日内容回向:
1如何将键和键值回填到工作表?
2回填工作表前要做好哪些准备?