Excel VBA解读（160）： 数据结构—字典对象的基本操作（续）

学习Excel技术，关注微信公众号：

excelperfect

本文继续讲解Dictionary对象的一些基本操作。

遍历字典元素

使用For Each循环来遍历字典元素，例如：

Sub testForEachLoop()

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

dict.Add Key:="完美Excel",Item:="excelperfect"

dict.Add "Microsoft","Excel"

dict.Add "花无缺",96

dict.Add 6, 88.98

dict.Add "2019-8-15", "考试"

Dim kValue As Variant

Debug.Print "键",vbTab, "值"

For Each kValue In dict.keys

Debug.Print kValue, vbTab, dict(kValue)

Next kValue

End Sub

运行结果如下图1所示。

图1

如果设置了早期绑定，那么还可以使用For循环来遍历字典元素，例如：

Sub testForEachLoop()

Dim dict As New Dictionary

dict.Add Key:="完美Excel",Item:="excelperfect"

dict.Add "Microsoft","Excel"

dict.Add "花无缺",96

dict.Add 6, 88.98

dict.Add "2019-8-15", "考试"

Dim i As Long

Debug.Print "键",vbTab, "值"

For i = 0 To dict.Count - 1

Debug.Print dict.Keys(i), vbTab, dict.Items(i)

Next i

End Sub

运行结果如下图2所示。

图2

排序操作

编写自定义函数，我们可以实现按键或者按值对字典元素排序。

按键排序

可以使用下面的自定义函数对指定的字典按键排序：

'按键排序

Function SortByKey(dict As Object, _

Optional order As XlSortOrder = xlAscending)_

As Object

'声明并创建ArrayList

Dim alArrList As Object

Set alArrList = CreateObject("System.Collections.ArrayList")

'添加字典元素到ArrayList

Dim k As Variant

For Each k In dict

alArrList.Add k

Next k

'按键排序

alArrList.Sort

'如果指定为降序,则按降序排序

If order = xlDescending Then

alArrList.Reverse

End If

'声明并创建新的字典

Dim dictNew As Object

Set dictNew = CreateObject("Scripting.Dictionary")

'将排好序的元素添加到新字典

For Each k In alArrList

dictNew.Add k, dict(k)

Next k

'释放对象

Set alArrList = Nothing

Set dict = Nothing

'返回排序结果

Set SortByKey = dictNew

End Function

代码使用了前面已学过的ArrayList对象。

使用下面的代码来测试SortByKey函数：

Sub testSortByKey()

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

'添加字典元素项

dict.Add "一年级",156

dict.Add "二年级",138

dict.Add "三年级",180

dict.Add "四年级",161

dict.Add "五年级",155

dict.Add "六年级",189

'调用过程打印字典元素

PrintDict "原字典",dict

'排序字典并输出排序后的结果

Set dict = SortByKey(dict)

PrintDict "键按升序排列",dict

'排序字典并输出排序后的结果

Set dict = SortByKey(dict, xlDescending)

PrintDict "键按降序排列",dict

End Sub

'打印字典元素项

Sub PrintDict(ByVal str As String, _

dict As Object)

Debug.Print vbCrLf & str

Dim k As Variant

'遍历字典元素并打印

For Each k In dict.Keys

Debug.Print k, dict(k)

Next k

End Sub

运行代码的结果如下图3所示。

图3

按值排序

可以使用下面的自定义函数对于指定的字典按值排序：

'按值排序

Function SortByValue(dict As Object, _

Optional order As XlSortOrder = xlAscending)_

As Object

'错误处理

On Error GoTo ErrH

'声明并创建ArrayList

Dim alArrList As Object

Set alArrList = CreateObject("System.Collections.ArrayList")

'声明并创建字典

Dim dictTemp As Object

Set dictTemp = CreateObject("Scripting.Dictionary")

'添加字典元素到ArrayList

'在dictTemp的键中存储值

'并将原字典的键存放在集合中

Dim k As Variant

Dim vAs Variant

Dim col As Collection

For Each k In dict

v = dict(k)

'添加元素

If dictTemp.exists(v) = False Then

Set col = New Collection

dictTemp.Add v, col

alArrList.Add v

End If

'将原字典键添加到集合

dictTemp(v).Add k

Next k

'按键排序

alArrList.Sort

'如果指定为降序,则按降序排序

If order = xlDescending Then

alArrList.Reverse

End If

dict.RemoveAll

'遍历ArrayList并添加值及对应的键

Dim item As Variant

For Each v In alArrList

Set col = dictTemp(v)

For Each item In col

dict.Add item, v

Next item

Next v

'释放对象

Set alArrList = Nothing

'返回排序结果

Set SortByValue = dict

Exit Function

ErrH:

If Err.Number = 450 Then

Err.Raise vbObjectError + 100, "按值排序字典",_

"不能完成排序"

End If

End Function

代码使用了前面已学过的ArrayList对象。并使用了一个临时创建的字典对象来过渡原字典的键和值，可以使用F8键来逐语句运行代码体验该技巧。

使用下面的代码来测试SortByValue函数：

Sub testSortByValue()

Dim dict As Object

Set dict = CreateObject("Scripting.Dictionary")

'添加字典元素项

dict.Add "一年级",156

dict.Add "二年级",138

dict.Add "三年级",180

dict.Add "四年级",161

dict.Add "五年级",155

dict.Add "六年级",189

'调用过程打印字典元素

PrintDict "原字典", dict

'排序字典并输出排序后的结果

Set dict = SortByValue(dict)

PrintDict "键按升序排列",dict

'排序字典并输出排序后的结果

Set dict = SortByValue(dict, xlDescending)

PrintDict "键按降序排列",dict

End Sub

'打印字典元素项

Sub PrintDict(ByVal str As String, _

dict As Object)

Debug.Print vbCrLf & str

Dim k As Variant

'遍历字典元素并打印

For Each k In dict.Keys

Debug.Print k, dict(k)

Next k

End Sub

运行代码的结果如下图4所示。

图4