VBA实现数组Array与集合Collection互换

数组和集合在VBA中是常用的数据类型，这里水文具工集在VBA中实现数组Array与集合Collection的相互转换，编写了两个通用的过程ArrayToCollection与CollectionToArray，方便程序中调用，具体源代码如下：

数组转换到集合ArrayToCollection

'================================
' VBA数组转换到集合ArrayToCollection
'
' http://www.cnhup.com '================================

Public Function ArrayToCollection( _
Arr As Variant, ByRef Coll As Collection) _
As Boolean
Dim Ndx As Long
Dim KeyVal As String

If IsArray(Arr) = False Then
ArrayToCollection = False
Exit Function
End If

On Error GoTo ErrH:
Select Case NumberOfArrayDimensions(Arr:=Arr)
Case 0
ArrayToCollection = False
Exit Function

Case 1
For Ndx = LBound(Arr) To UBound(Arr)
Coll.Add Item:=Arr(Ndx)
Next Ndx

Case 2
For Ndx = LBound(Arr, 1) To UBound(Arr, 1)
KeyVal = Arr(Ndx, 1)
If Trim(KeyVal) = vbNullString Then
Coll.Add Item:=Arr(Ndx, 1)
Else
Coll.Add Item:=Arr(Ndx, 0), Key:=KeyVal
End If
Next Ndx

Case Else
ArrayToCollection = False
Exit Function

End Select

ArrayToCollection = True
Exit Function

ErrH:
ArrayToCollection = False

End Function

集合转换到数组CollectionToArray

'================================
' VBA集合转换到数组CollectionToArray
'
' http://www.cnhup.com '================================

Public Function CollectionToArray( _
Coll As Collection, Arr As Variant) _
As Boolean
Dim V As Variant
Dim Ndx As Long

If Coll Is Nothing Then
CollectionToArray = False
Exit Function
End If

If IsArray(Arr) = False Then
CollectionToArray = False
Exit Function
End If
If IsArrayDynamic(Arr:=Arr) = False Then
CollectionToArray = False
Exit Function
End If

If Coll.Count < 1 Then
CollectionToArray = False
Exit Function
End If

ReDim Arr(1 To Coll.Count)

For Ndx = 1 To Coll.Count
If IsObject(Coll(Ndx)) = True Then
Set Arr(Ndx) = Coll(Ndx)
Else
Arr(Ndx) = Coll(Ndx)
End If
Next Ndx

CollectionToArray = True

End Function