学习Excel技术,关注微信公众号:
excelperfect
集合是一种很有用的数据结构,能够让我们更方便地实现一些程序功能。本文介绍几段代码,能够进一步增强集合的功能。
判断键值是否存在
在集合中,没有内置方法判断键是否已存在。下面的代码检查指定的键是否已存在:
Function KeyIsExists(col AsCollection, key As String) As Boolean
On Error GoTo ExitHere
col.Item key
KeyIsExists = True
ExitHere:
End Function
测试KeyIsExists函数的代码如下:
Sub testKey()
Dim colMy As New Collection
colMy.Add Item:="完美Excel", key:="excelperfect"
colMy.Add Item:="微信公众号", key:="weixin"
Debug.Print KeyIsExists(colMy, "excelperfect")
Debug.Print KeyIsExists(colMy, "me")
End Sub
运行结果如下图1所示。
图1
对集合元素进行排序
在集合中,没有内置的排序方法。这里,使用快速排序算法来对集合中的元素排序:
Sub SortToCollection(col AsCollection, lFirst As Long, lLast As Long)
Dim vMiddle As Variant, vTemp As Variant
Dim lTempLow As Long
Dim lTempHi As Long
lTempLow = lFirst
lTempHi = lLast
vMiddle = col((lFirst + lLast) \ 2)
Do While lTempLow <= lTempHi
Do While col(lTempLow) < vMiddle AndlTempLow < lLast
lTempLow = lTempLow + 1
Loop
Do While vMiddle < col(lTempHi) AndlTempHi > lFirst
lTempHi = lTempHi - 1
Loop
If lTempLow <= lTempHi Then
'交换值
vTemp = col(lTempLow)
col.Add col(lTempHi),After:=lTempLow
col.Remove lTempLow
col.Add vTemp, Before:=lTempHi
col.Remove lTempHi + 1
'移到到下一个位置
lTempLow = lTempLow + 1
lTempHi = lTempHi - 1
End If
Loop
If lFirst < lTempHi Then SortToCollection col, lFirst, lTempHi
If lTempLow < lLast Then SortToCollection col, lTempLow, lLast
End Sub
测试SortToCollection过程的代码如下:
Sub testSort()
Dim colMy As New Collection
colMy.Add "3"
colMy.Add "9"
colMy.Add "2"
colMy.Add "5"
colMy.Add "1"
SortToCollection colMy, 1, colMy.Count
Dim temp As Variant
For Each temp In colMy
Debug.Print temp
Next temp
End Sub
运行结果如下图2所示。
图2
获取唯一值
可以利用集合的键不能重复的特点,来获取列表中不重复的值。下面的GetUniqueValue函数返回一个集合,其元素内容不重复:
Function GetUniqueValue(ValueList)As Collection
Dim colUnique As New Collection
Dim var As Variant
On Error Resume Next
For Each var In ValueList
colUnique.Add var, CStr(var)
Next var
Set GetUniqueValue = colUnique
End Function
代码中,给集合添加元素时,键值使用了CStr函数将键值转换成字符串,因为键值只能是字符串。
下面来测试GetUniqueValue函数。如下图3所示的工作表Sheet1的列A中有一系列数据:
图3
下面的代码使用GetUniqueValue函数获取列A中的不重复值:
Sub testUnique()
Dim rng As Range
Dim colTemp As Collection
Dim temp As Variant
With Worksheets("Sheet1")
Set rng = .Range("A1", .Range("A1").End(xlDown))
End With
Set colTemp = GetUniqueValue(rng)
For Each temp In colTemp
Debug.Print temp
Next temp
End Sub
运行代码的结果如下图4所示。
图4
注意
1.如果要声明遍历集合的变量,则应将其声明为Variant型。
2.不能对集合中已有元素直接重新赋值。
3.集合是对象,因此返回集合时应使用Set来赋值。