.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With
Target.Offset(0, 1) = \
ElseIf Target.Column = 4 And Target.Offset(0, -1) <> \Then For i = 1 To UBound(Arr) If Arr(i, 1) <> \Then r = r + 1
ReDim Preserve Arr1(1 To r) Arr1(r) = i End If Next i For i = 1 To r
If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then If i <> r Then
js = Arr1(i + 1) - 1 Else
js = Myr - 1 End If ks = Arr1(i) For j = ks To js
cp = cp & Arr(j, 2) & \ Next End If Next i
cp = Left(cp, Len(cp) - 1) With Target.Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=cp End With
Target = Split(cp, \
31
End If
Set d = Nothing End Sub
三、代码详解
1、Private Sub Worksheet_SelectionChange(ByVal Target As Range) ：本例用的是工作表选择变化事件，只要鼠标点击单元格都会激活这个事件。Private 可译为私有的，限制了这段代码只能在指定的工作表里有效。参数Target声明为单元格区域对象，有了关键字ByVal，说明可以按值传递参数。
2、If Target.Count > 1 Then Exit Sub ：由于是鼠标点击单元格都会激活这个事件,所以最好要作一些限制，使得你能避免点击了不需要激活事件的地方而激活本事件产生错误。本句是如果目标单元格的数目大于1就退出本过程。这样当你点选了多个单元格的时候，过程运行了这句代码就会结束过程了。
3、If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub ：再加一个限制，如果目标单元格的列不是3列（C列）也不是4列（D列）的话就退出过程。
4、接着的四句代码分别是声明变量、创建字典对象、B列最后一个非空单元格的行数以及把单元格区域的值赋给数组变量等等与前面的实例相同。请注意这里选择了B列求最后一个非空单元格的行数，是因为A列各数据之间有空格，如果选择A列，就会遗漏一些数据。
5、If Target.Column = 3 Then ：现在分两种情况判断，如果点击的目标单元格是C列的，那么执行下面的代码。
6、If Arr(i, 1) <> \Then ：在数组Arr之间逐一循环，如果A列数组的值不等于空，就作为关键字加入字典d。这样就排除了空值进入字典。
7、With Target.Validation ：这里使用了With语句，With语句为我们提供了十分简便的对象引用手段。使用它有3个优点：可以减少代码的输入量、增加代码的可读性。改善代码的执行效率。在End With之前的语句都是对目标单元格的有效性对象的各个属性进行设置。
8、.Delete ：先删除该单元格的数据有效性。注意Delete前有个小圆点，在小圆点之前就省略了Target.Validation，即减少了代码的输入量。这个小圆点不能遗漏，否则会出错。
9、.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(d.keys, \：Add是有效性对象的方法，向指定区域内添加数据有效性检验。参数Type是数据有效性类型，当类型等于xlValidateList时，后面的公式1参数Formula1 必须包含以逗号分隔的取值列表。参数AlertStyle是出错警告样式，这里是停止样式；参数Operator是数据有效性运算符，有大于、小于、大于或等于、小于或等于、介于、不介于、等于、不等于等等，这里取介于；公式1参数Formula1的值用了VBA函数Join，把字典的关键字用逗号分隔后连接起来赋给公式1参数。这样，目标单元格那的数据有效性中就没有重复值了。
32
10、Target.Offset(0, 1) = \ ：给目标单元格设置了数据有效性以后，把它同行D列单元格的值清除。这是为了确保D列的值只与C列的目标名称相对应。
11、ElseIf Target.Column = 4 And Target.Offset(0, -1) <> \ ：否则如果目标单元格是D列的，并且同行C列单元格不是空的情况下，执行这下面的代码。Offset属性的详解可见前面实例6的第2条解释。
12、For i = 1 To UBound(Arr) ：在数组Arr之间逐一循环。
13、If Arr(i, 1) <> \ ：如果A列数组的值不等于空，就执行下面的代码。 14、r = r + 1 ：变量r累加。
15、ReDim Preserve Arr1(1 To r) ：重新声明动态数组的大小，Preserve是关键字，当改变原有数组最末维的大小时，使用此关键字可以保持数组中原来的数据。这句是改变动态数组大小的最常用语句，不能忘记Preserve关键字。
16、Arr1(r) = i ：把关键字在数组Arr中行的位置赋给新的动态数组Arr1(r)。这个循环可求得A列每一个源名称所在的行的位置。
17、For i = 1 To r ：上面的循环求得了一共有r个源名称，逐一循环。
18、If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then ：如果C列的目标名称等于源名称时执行下面的代码。
19、If i <> r Then ：如果i不等于r时执行下面的代码。
20、js = Arr1(i + 1) – 1 ：把下一个源名称所在的行数-1以后赋给变量js，这样来求得每一个源名称的开始和结束的位置。
21、js = Myr – 1 ：否则就是最后一行－1的只赋给变量js（最后一个源名称在数组中的位置）。
22、ks = Arr1(i) ：把数组的值赋给变量ks：得到每一个源名称的起始位置。 23、For j = ks To js ：从每一个源名称的起始位置到结束位置逐一循环。
24、cp = cp & Arr(j, 2) & \ ：把相应的代号与逗号连接起来组成的字符串赋给变量cp。
25、cp = Left(cp, Len(cp) - 1) ：用了两个VBA函数Left和Len把去掉末位的逗号。
26、With 语句解释同上，为D列单元格设置了第2级数据有效性。
27、Target = Split(cp, \：按照问题的第3个要求，在目标名称确定后，在目标代号相应位置自动生成目标名称的第一个代号。因为Split得到的是一个以0为下界的一维函数，所以它的第一个元素就用(0)来表示。
代码执行后如图实例8-2所示。
33
图 实例8-2示例
实例9 字典取行数，数组重新赋值
一、问题的提出：
要求编写一段代码，求得B列不重复的名字，其相应的A列和D列分别用\\连起来，而相应的E列F列的数值分别相加汇总。
代码执行前如图实例9-1所示。
34
图 实例9-1示例
二、代码： Sub yy() 'by:Zamyi
Dim d As New Dictionary, R Dim k, i&, j& R = Sheet1.UsedRange k = 1
For i = 2 To UBound(R)
R(i, 2) = Replace(Replace(R(i, 2), \（\\\）\\ If d.Exists(R(i, 2)) Then
R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & \\& R(i, 1) R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & \\& R(i, 4) R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5) R(d(R(i, 2)), 6) = Val(R(d(R(i, 2)), 6)) + R(i, 6) Else
k = k + 1 d(R(i, 2)) = i
35