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


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