实例11 关键字赋给两列后用Replace方法
一、问题的提出：
有如图实例11-1所示的工资表，要求编写一段代码，运用VBA自动生成1季度的工资表。
解题思路：先把性别和姓名连起来作为关键字求得人员的不重复值，然后通过循环查找关键字获得其各月的工资，最后用Replace方法替换两列关键字区域得到各自的数据。
代码执行前如图实例11-1所示。
图 实例11-1示例
二、代码：
41
Sub yy()
Dim d, k, t, i&, j&, Arr, x, r1
Set d = CreateObject(\Arr = [a1].CurrentRegion
For i = 1 To UBound(Arr, 2) Step 3 For j = 2 To UBound(Arr) If Arr(j, i) <> \Then
x = Arr(j, i) & \& Arr(j, i + 1) d(x) = \ End If Next Next k = d.keys
[a12:i1000].ClearContents
[a13].Resize(d.Count, 2) = Application.Transpose(k) [a12:b12] = Array(\性别\\姓名\For i = 3 To UBound(Arr, 2) Step 3 Cells(12, 2 + i / 3) = Cells(1, i) Next
For i = 3 To UBound(Arr, 2) Step 3 For j = 2 To UBound(Arr) If Arr(j, i) <> \Then
x = Arr(j, i - 2) & \& Arr(j, i - 1) Set r1 = [a13].Resize(d.Count, 1).Find(x, , , 1) Cells(r1.Row, 2 + i / 3) = Arr(j, i) End If Next Next
[a13].Resize(d.Count, 1).Replace \\xlPart [b13].Resize(d.Count, 1).Replace \\xlPart End Sub 三、代码详解
42
1、Arr = [a1].CurrentRegion ：把含有A1单元格的当前单元格区域的值赋给变量Arr。CurrentRegion是Range对象的属性，当前区域指以任意空白行及空白列的组合为边界的区域。如本题A11单元格有数据，但是因为第10行是空白行，所以没有包含在A1的当前区域里面。
2、For i = 1 To UBound(Arr, 2) Step 3 ：For-Next控制结构，从1 到数组第2维的最大上界每隔3进行一次循环，Step 3是循环的步长，第一次循环时i=1；第2次循环时i=1+3=4，第3次时i=4+3=7。
3、For j = 2 To UBound(Arr) ：从第2行开始循环。没有Step时默认Step为1。 4、If Arr(j, i) <> \ ：If-Then-Else控制结构可根据测试条件的结果改变程序执行的流程。本句测试条件是Arr(j, i) <> \，判断性别是否为空白，如果不为空白则执行下面的语句，否则，执行Else下面的语句。
5、x = Arr(j, i) & \：把性别和姓名中间加“|”连起来赋给变量x。 6、d(x) = \ ：把x的值作为关键字加入字典d。比如把”男|赵” 加入字典d。这两个循环把每个月的所有的人员都加入了字典d，字典中的人员是没有重复的。 7、k = d.keys ：把字典d所有的关键字赋给变量k。
8、[a12:i1000].ClearContents ：清空A12：I1000单元格区域。
9、[a13].Resize(d.Count, 2) = Application.Transpose(k) ：把变量k转置之后赋给A13开始的单元格区域。Resize是Range对象的属性，调整指定区域的大小，其第1个参数是行的大小，d.Count表示字典关键字的数量，如果有10个关键字，那么就是10行；其第2个参数是列的大小，一般是赋给1列的，本例关键字由两个数据合并而成，所以先赋给2列，后面再处理。
10、[a12:b12] = Array(\性别\\姓名\ ：Array是一个VBA函数，返回一个下界为0的一维数组。一维数组可以看作是水平排列的，这里作为表头一次性输入。 11、For i = 3 To UBound(Arr, 2) Step 3 ：从第3列开始循环，步长为3。 12、Cells(12, 2 + i / 3) = Cells(1, i) ：把“1月工资“、“2月工资“等输入到相应表头的位置。
13、Set r1 = [a13].Resize(d.Count, 1).Find(x, , , 1) ：在A13单元格开始的区域中查找字符串变量x，Find方法是Range对象的一个方法，其中第4个参数值为1，其常量为xlWhole，表示精确查找，另一个常量为xlPart，它的值＝2。Find方法返回的是Range对象，所以前面要用Set语句来引用对象。
14、Cells(r1.Row, 2 + i / 3) = Arr(j, i) ：把关键字对应的工资赋给相应的单元格里。 15、[a13].Resize(d.Count, 1).Replace \\xlPart ：Replace方法是Range对象的一个方法，其第1个参数是要查找的字符串，这里\是竖线及后面所有的字符串；其第2个参数是替换字符串，这里替换为空；其第3个参数是精确查找还是模糊查找，xlPart常量的值＝2，可以用2代替它。本句是把姓名替换掉，只留下性别；下一句把B列中的性别替换掉，只留下姓名。 代码执行后如图实例11-2所示。
43
图 实例11-2示例
实例12 复杂报表汇总
一、问题的提出 ：
有一日报表，里面有生产型号、生产数量、返修原因、返修数量、报废原因、报废数量，要求编写一段代码，按同型号产品汇总生产数量；得到同型号产品相同返修原因的唯一值；按同型号产品相同返修原因汇总返修数量； 得到同型号产品相同报废原因的唯一值；同型号产品相同报废原因汇总报废数量，并且合并相同内容的单元格。
代码执行前如图实例12-1所示。
44
图 实例12-1示例
二、代码： Sub bbhz()
Dim i&, Myr&, x(1 To 3), Arr, n%, aa, j&, Arr1(), r%, Arr2(), r2%, r3%, Arr3() Dim d(1 To 3) As New dictionary, k(1 To 3), t(1 To 3), js, ks, ii%, jj&, ks1, js1 Application.ScreenUpdating = False Myr = Sheet1.[a65536].End(xlUp).Row Arr = Sheet1.Range(\& Myr) For i = 1 To UBound(Arr) x(1) = Arr(i, 2)
d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3) x(2) = Arr(i, 2) & \& Arr(i, 4) d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5)
x(3) = Arr(i, 2) & \& Arr(i, 4) & \& Arr(i, 6) d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7) Next
For i = 1 To 3
45