学习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