数组集合互转

/db_自贡黄明儒_ · 发表于 2016-11-18 10:59:19

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

' http://www.cnhup.com
'================================
'VBA数组转换到集合CollectionToArray
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
'================================
' 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

' <a href=\"http://www.cnhup.com\" target=\"_blank\">http://www.cnhup.com</a> 
'================================ 
'VBA数组转换到集合CollectionToArray 
 
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 
 
'================================ 
' VBA集合转换到数组CollectionToArray 
' 
' <a href=\"http://www.cnhup.com\" target=\"_blank\">http://www.cnhup.com</a> 
'================================ 
 
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

账号		自动登录	找回密码
密码			立即注册

[分享] 数组 集合 互转

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

[分享] 数组集合互转