VBA：Excel：コレクション

注意

'Collectionに対して以下のように処理すると､
'後ろの要素に行くにしたがってより処理時間がかかってしまうようになります｡
'Dim i As Long
'For i = 1 To colls.Count
'    Debug.Print colls(1)
'Next
'コレクションのメモリ構造がチェーンのように次々につながっている事に起因します｡
'コレクション対して全件処理する場合は､次回説明するFor Eachを使って以下のように処理してください｡
' https://excel-ubara.com/excelvba1/EXCELVBA358.html

TEST

Public Sub aTEST_Collection()

  '===========================================================
  '【遅延バインディング】
  '  Dim Dictionary名 As Object
  '  Set Dictionary名 = CreateObject("Scripting.Dictionary")
  '===========================================================


  '=====================================================
  '// 追加・カウント・削除・取得・KEY存在確認
  '=====================================================
  Dim colc01 As Collection
  Set colc01 = New Collection
  
'// 追加
'//   object.Add item, key, before, afte
  colc01.Add "VAL", "KEY"
  colc01.Add "AAAA", "a"     'Add some keys and items
  colc01.Add "BBBB", "b"
  colc01.Add "CCCC", "c"
  colc01.Add "DDDD"
  
'// カウント
  Debug.Print colc01.Count          '// カウント
  
'// 取得
  Debug.Print colc01("KEY")
  Debug.Print colc01("a")
        
  Dim vFE As Variant
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE
        
'// IsExists
  
'// Remove
  colc01.Remove "b"
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE
  
  colc01.Remove 1
  For Each vFE In colc01
      Debug.Print vFE
  Next vFE

  Call getRemoveAll(colc01)

'//


End Sub

要素存在確認

'*****************************************************************
'* 要素存在確認
'*
'* ARG 01 : 対象Collection
'* ARG 02 : Collectionの要素
'* 戻り値 :
'*
'*****************************************************************
Function getColcIsExists( _
                            colc As Collection, _
                            vItem As Variant _
                            ) As Boolean
  Dim vFE As Variant
  For Each vFE In colc
    If vFE = vItem Then
      getColcIsExists = True
      Exit Function
    End If
  Next vFE
  
  getColcIsExists = False
    
End Function

Collection → クリア

'*****************************************************************
'* Collection → クリア
'*
'* ARG 01 : 対象Collection
'* 戻り値 :
'*
'*****************************************************************
Public Sub getColcRemoveAll( _
                            ByRef colc As Collection _
                            )
  
  Dim i As Long
  For i = 1 To colc.Count
    colc.Remove 1
  Next i
    
End Sub

Collection → 配列

'*****************************************************************
'* Collection → 配列
'*
'* ARG 01 : 対象Collection
'* 戻り値 :
'*
'*****************************************************************
Public Function getCollectToArray( _
                                  ByVal colTrg As Collection _
                                  ) As Variant

  Dim vRes As Variant
  ReDim vRes(colTrg.Count - 1)
 
  Dim i As Long
  i = LBound(vntResult)
  
  Dim vFE As Variant
  For Each vFE In colTrg
    vntResult(i) = vFE
    i = i + 1
  Next vFE
 
  getCollectToArray = vRes
  
End Function