Excel VBA解读（151）： 数据结构——增强集合功能的代码

学习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
        Do While vMiddle < col(lTempHi) AndlTempHi > lFirst
            lTempHi = lTempHi - 1
        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
   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