实例6 多条件复杂汇总
ReDim b(1 To UBound(a), 1 To 8) For i = 1 To UBound(a)
ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) If Not d.Exists(ss) Then
n = n + 1 d.Add ss, n
b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4) b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) Else
b(d(ss), 7) = b(d(ss), 7) & \& a(i, 9) End If Next
For i = 1 To d.Count
x = Split(b(i, 7), \For j = 0 To UBound(x)
w = w + x(j) Next j
b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 Next
[b4].Resize(n, 8) = b End Sub
三、代码详解
1、Dim d As Object, a, b, j%, w! ：Dim语句中的j% 等同于Dim j As Integer。w! 等同于Dim w As Single。类似的还有ss$ 等同于Dim ss As String。还有双精度数据类型Double的类型声明字符为#、货币数据类型Currency的类型声明字符为@。
2、Me.UsedRange.Offset(3, 0) = \：Offset是Range对象的属性，Offset(3, 0)的第
一个参数是行数；第二个参数是列数，意思是往下偏移3行，列不变。Me是活动工作表，相当于Activesheet; UsedRange为已经使用的单元格区域。本句可解释为：清空第3行以下的单元格。
3、a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp)) ：把原始数据所在的表1自A4以下的I列最后的非空单元格区域的值赋给变量a。
4、Set d = CreateObject(\：创建字典对象d。
5、ReDim b(1 To UBound(a), 1 To 8) ：根据数组a的大小重新声明数组b。 6、For i = 1 To UBound(a) ：在1 和数组a第一维的上界值之间逐一循环。
25
常见字典用法集锦及代码详解
7、ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) ：把多个条件比例、位置、项目名称、大系统编号、小系统编号和相同楼层数用连接符号&连成一个字符串，然后赋给变量ss。
8、If Not d.Exists(ss) Then ：If…Then结构利用了字典的Exists方法和Not来判断：如果字典d里面不存在ss表示的关键字，那么执行下面的语句。 9、n = n + 1 ：把变量n增加1以后仍然赋给n。
10、d.Add ss, n ：把ss的值作为关键字，n的值作为对应的项一起加入字典d中。n的值实际是关键字的位置次序，如n=1时是第一个关键字；n=2时是第二个关键字。
11、b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4) ：为了使代码看起来简短一些，可以用冒号”:”把多个语句连成一行。4个语句分别给数组b的各个元素赋以对应的值。
12、b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) ：与上述的11条相同。
13、否则执行这句：b(d(ss), 7) = b(d(ss), 7) & \& a(i, 9) ：d(ss)等于关键字对应的项，在本例里等于对应的n的值。本句是把图纸长度a(i, 9)用\连起来赋给数组b，这样就得到了长度明细一栏数据。
14、For i = 1 To d.Count ：在字典关键字数目中逐一循环。
15、x = Split(b(i, 7), \ ：运用VBA函数Split把b(i, 7)（长度明细）按照\分割，返回一个下标从零开始的一维数组x。如果要详细了解Split函数的，可参见我的另一篇文章“常用VBA函数精选合集”。http://club.excelhome.net/thread-387253-1-1.html
16、For j = 0 To UBound(x) ：在上面的x数组之间逐一循环。
17、w = w + x(j) ：把变量w加x(j)数组的一个元素以后仍然赋给w。实际得到x数组的累加值。
18、b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 ：w求出后经过按要求计算得到的值赋给数组b的第8列元素。（数量列）另一句把变量w置0。避免在新一次的循环中误加进去。
19、[b4].Resize(n, 8) = b ：最后把数组b赋给B4开始的单元格区域。
代码执行后如图实例6-1所示。
26
实例7 字典法排序
图 实例6-1示例
实例7 字典法排序
一、问题的提出：
A列B列是按顺序排列的全部股票代码和股票名称，C列D列和E列F列是另外按条件筛选出来的无序的数据， 要求编写一段代码，将它们排列到与A列相同的股票行里面。
代码执行前如图实例7-1所示。
27
常见字典用法集锦及代码详解
图 实例7-1示例
二、代码：
Private Sub CommandButton1_Click() ?by:oobird Dim d As Object, rng, i%, j%, arr Set d = CreateObject(\rng = Range(\& [a65536].End(xlUp).Row) ReDim arr(1 To UBound(rng), 1 To 4) For i = 1 To UBound(rng)
d(CStr(rng(i, 1))) = i Next i
For j = 3 To 5 Step 2
For i = 1 To Cells(65536, j).End(xlUp).Row - 2
If d(CStr(rng(i, j))) <> \Then
arr(d(CStr(rng(i, j))), j - 2) = rng(i, j) arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1) End If Next i Next j
28