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