实例9 字典取行数，数组重新赋值

For j = 1 To UBound(R, 2) R(k, j) = R(i, j) Next End If Next With Sheet2

.Cells.ClearContents

.Cells.Borders.LineStyle = xlNone .[a1:F1].Resize(d.Count + 1) = R

.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1 End With Set d = Nothing End Sub

三、代码详解

1、R = Sheet1.UsedRange ：把表1的已经使用了的单元格区域的值赋给变量R。 2、k = 1 ：变量k赋初值1。

3、For i = 2 To UBound(R) ：由于第一行是表头，所以从第2行开始循环。

4、R(i, 2) = Replace(Replace(R(i, 2), \（\\\）\\ ：由于源数据中用了不统一的括号，所以加了这句把里面中文括号统一替换为英文括号。这句用了两次VBA函数Replace，一次替换前半个，另一次替换后半个。Replace函数有6个参数，详细请查阅VBA帮助文件。如果在这里解释，篇幅太长了，也冲淡了字典的主题。 5、If d.Exists(R(i, 2)) Then ：这句用字典的Exists方法进行判断，如果字典中存在R(i, 2)这个关键字，那么执行下面的代码。

6、这里先解释，Else如果上面的判断不成立，即字典中不存在这个关键字时，要执行下面的代码。

7、k = k + 1 ：变量k+1以后再赋给k。

8、d(R(i, 2)) = i ：公司名字作为关键字，对应的项是它所在的行，把它们加入字典d。

9、For j = 1 To UBound(R, 2) ：知道了这个关键字所在的行，下面这个循环就是重新给数组同一行的各个元素赋值。UBound(R, 2)是用VBA函数Ubound求得数组R的第2维的最大上界。比如本例R数组第1维的最大上界是8，有8行数据；而第2维的最大上界是6，有6列数据。本循环j就是从第1列到第6列依次循环。 10、R(k, j) = R(i, j) ：把i行j列的数组元素赋给k行j列的R数组元素。

11、R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & \ ：再回来说如果R(i, 2)这个关键字存在，则执行这条代码。在这之前，这关键字已经加入字典了，它的同一行的各个数

37

常见字典用法集锦及代码详解

组元素也重新赋过值了，所以根据问题的要求，把A列的数据用\连起来再赋给A列这个数组元素。

12、R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & \ ：D列数据同上。

13、R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5) ：E 列数据要相加，这里用了VBA函数Val，把E列数组元素转为数值以后相加汇总。下句类同。 14、With Sheet2 ：With语句，前面介绍过的。

15、.Cells.ClearContents ：清空表2所有的数据。Cells是工作表对象的属性，指工作表所有的单元格；ClearContents是它的方法，清除里面的公式、数据，但是保留格式设置。

16、.Cells.Borders.LineStyle = xlNone ：清除表2所有的边框。Borders是Cells的属性，意思是单元格的边框；LineStyle是边框的属性，为边框的线型，它有直线、虚线、点划线等等，这里取值xlNone是清除边框。

17、.[a1:F1].Resize(d.Count + 1) = R ：把数组R的值赋给表2A1单元格开始的区域。

18、.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1 ：给这些单元格添加边框，线型为直线。

代码执行后如图实例9-2所示。

图 实例9-2示例

38

实例10 先字典求得行后显示整行数据

实例10 先字典求得行后显示整行数据

一、问题的提出：

有3列数据，要求编写一段代码，如果C列名次、A列主排相同时，根据B列次排最大的只保留一行。

解题思路：先对3列数据按主要关键字名次_升序，次要关键字主排_升序，第3关键字次排_降序进行排序，然后运用字典，以”名次|主排” 作为关键字，它所在的行作为关键字的项加入字典，最后根据行引用相对的单元格值。

代码执行前如图实例10-1所示。

图 实例10-1示例

二、代码： Sub pmc()

Dim i&, Myr&, Arr Dim d, x, rng

Application.ScreenUpdating = False Set d = CreateObject(\Sheet1.Activate

Myr = [a65536].End(xlUp).Row

39

常见字典用法集锦及代码详解

Range(\& Myr).Sort Key1:=Range(\Order1:=xlAscending, Key2:=Range( _ \Order2:=xlAscending, Key3:=Range(\Order3:=xlDescending, _ Header:=xlYes Arr = Range(\& Myr) For i = 1 To UBound(Arr)

x = Arr(i, 1) & \& Arr(i, 3) If Not d.exists(x) Then d.Add x, i + 1 End If Next

[e:g].ClearContents

[e2].Resize(d.Count, 1) = Application.Transpose(d.items) For Each rng In [e2].Resize(d.Count, 1)

rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value Next

Set d = Nothing

Application.ScreenUpdating = True End Sub

三、代码详解

1、Application.ScreenUpdating = False ：关闭屏幕更新。关闭屏幕更新可加快宏的执行速度。请记住当宏结束执行时，将 ScreenUpdating 属性设回到 True。

2、Range(\& Myr).Sort Key1:=Range(\Order1:=xlAscending,

Key2:=Range(\

Header:=xlYes ：对ABC三列进行排序。主要关键字Key1名次_升序，次要关键字

Key2主排_升序，第3关键字Key3次排_降序。

3、Arr = Range(\：把ABC列数据赋给变量Arr。

4、For i = 1 To UBound(Arr) ：i从1到数组Arr的最大上界逐一循环。 5、x = Arr(i, 1) & \：把主排和”|”和名次连起来赋给变量x。

6、If Not d.exists(x) Then ：如果字典中不存在x这个关键字，那么执行下面的代

码。

7、d.Add x, i + 1 ：把x作为关键字和这个关键字的具体的行作为对应的项加入字典。因为数组Arr是从A2开始的，所以i与数据的实际行相差1，i+1就是数据的实际行。

8、[e:g].ClearContents ：清空E~G列。

40