VBA：Excel ：コレクション

参考

コレクションとは（Collection）｜VBA入門
Collection オブジェクト | Microsoft Docs
Add メソッド (Visual Basic for Applications) | Microsoft Docs
Item メソッド (Visual Basic for Applications) | Microsoft Docs
Remove メソッド (Visual Basic for Applications) | Microsoft Docs
Count プロパティ (Visual Basic for Applications) | Microsoft Docs
【Excel VBA入門】Collectionとは？サイズ変更に強いリストの作り方 – Valmore
[VBA]Collectionを知り、使い方を知る

コレクションのコレクション

行列データでデータラベル（説明）を付けてみる

Collection（Collection（Collection（Collection）））【LOOPデータ】

全体：行：列：データ詳細

    Dim all_Collecction As Collection
    Set all_Collecction = New Collection
    
    Dim lRow As Long
    For lRow = 1 To 7   '// ７行
        
        Dim r_Collecction As Collection
        Set r_Collecction = New Collection
        
        Dim lCol As Long
        For lCol = 1 To 5   '// ５列
            Dim c_Collecction As Collection
            Set c_Collecction = New Collection
        
            '============================================
            ' データ詳細（名前付きデータ）
            '============================================
            Dim lDat As Long
            For lDat = 1 To 5   '// 6データ
                 
                '-------------------------------------------
                    Dim dat_Collecction As Collection
                '-------------------------------------------
                    
                    Set dat_Collecction = New Collection            '// 初期化
                        Call dat_Collecction.Add("LABEL_" & lDat)   '// データ作成
                        Call dat_Collecction.Add(lDat)              '// データ作成
                    Call c_Collecction.Add(dat_Collecction)         '// 1つ上に格納
                        
                '-------------------------------------------
                    Set dat_Collecction = Nothing   '// 1つ上に格納したら、次のために解放
                '-------------------------------------------
            
            Next lDat
            
            '// カラムの塊を１行のエリアへ
            Call r_Collecction.Add(c_Collecction)   '// 1つ上に格納
            Set c_Collecction = Nothing             '// 1つ上に格納したら、次のために解放
            
        Next lCol
    
        '// 行の塊を全データのエリアへ
        Call all_Collecction.Add(r_Collecction)     '// 1つ上に格納
        Set r_Collecction = Nothing                 '// 1つ上に格納したら、次のために解放
    
    Next lRow
    
    
    Debug.Print "行数 : " & all_Collecction.Count
    Debug.Print "列数 : " & all_Collecction.Item(1).Count
    Debug.Print "データ数 : " & all_Collecction.Item(1)(1).Count
    
    '// 1行,2列,5番目データのラベル
    Debug.Print "データ_ラベル : " & all_Collecction.Item(1)(2)(3)(1)
    
    '// 1行,2列,5番目データのデータ
    Debug.Print "データ_Data : " & all_Collecction.Item(1)(2)(3)(2)

End Sub

Collection（Collection（Collection（Collection））） 【個別データ】

全体：行：列：データ詳細

Public Sub mth_Collection()

    Dim all_Collecction As Collection
    Set all_Collecction = New Collection
    
    Dim lRow As Long
    For lRow = 1 To 7   '// ７行
        
        Dim r_Collecction As Collection
        Set r_Collecction = New Collection
        
        Dim lCol As Long
        For lCol = 1 To 5   '// ５列
            Dim c_Collecction As Collection
            Set c_Collecction = New Collection
        
            '============================================
            ' データ詳細（名前付きデータ）
            '============================================
             
            '-------------------------------------------
                Dim dat_Collecction As Collection
            '-------------------------------------------
                
                Set dat_Collecction = New Collection
                    Call dat_Collecction.Add("行番号")
                    Call dat_Collecction.Add(lRow)
                Call c_Collecction.Add(dat_Collecction)     '// データの塊を１カラムのエリアへ
                    
                Set dat_Collecction = New Collection
                    Call dat_Collecction.Add("列番号")
                    Call dat_Collecction.Add(lCol)
                Call c_Collecction.Add(dat_Collecction)     '// データの塊を１カラムのエリアへ
                    
                Set dat_Collecction = New Collection
                    Call dat_Collecction.Add("色データ_" & lCol)
                    Call dat_Collecction.Add("255,0," & lCol)
                Call c_Collecction.Add(dat_Collecction)     '// データの塊を１カラムのエリアへ
                    
                Set dat_Collecction = New Collection
                    Call dat_Collecction.Add("数式")
                    Call dat_Collecction.Add("=SUM()")
                Call c_Collecction.Add(dat_Collecction)     '// データの塊を１カラムのエリアへ
            
            '-------------------------------------------
                Set dat_Collecction = Nothing
            '-------------------------------------------
        
            '// カラムの塊を１行のエリアへ
            Call r_Collecction.Add(c_Collecction)
            
            Set c_Collecction = Nothing
            
        Next lCol
    
        '// 行の塊を全データのエリアへ
        Call all_Collecction.Add(r_Collecction)
        
        Set r_Collecction = Nothing
    Next lRow
    
    
    Debug.Print "行数 : " & all_Collecction.Count
    Debug.Print "列数 : " & all_Collecction.Item(1).Count
    Debug.Print "データ数 : " & all_Collecction.Item(1)(1).Count
    
    '// 1行,2列,3番目データのラベル
    Debug.Print "データ_ラベル : " & all_Collecction.Item(1)(2)(3)(1)
    
    '// 1行,2列,3番目データのデータ
    Debug.Print "データ_Data : " & all_Collecction.Item(1)(2)(3)(2)

End Sub

Collection（Collection（Collection（Array）））

全体：行：列：データ詳細（配列）

Public Sub mth_Collection_Arr()

    Dim all_Collecction As Collection
    Set all_Collecction = New Collection
    
    Dim lRow As Long
    For lRow = 1 To 7   '// ７行
        
        Dim r_Collecction As Collection
        Set r_Collecction = New Collection
        
        Dim lCol As Long
        For lCol = 1 To 5   '// ５列
            Dim c_Collecction As Collection
            Set c_Collecction = New Collection
        
            '============================================
            ' データ詳細（名前付きデータ）
            '============================================
             
            '-------------------------------------------
                Dim dat_Collecction As Collection
            '-------------------------------------------
                Dim Arr()
                
                Arr = Array("行番号", lRow)
                Call c_Collecction.Add(Arr)     '// データの塊を１カラムのエリアへ
                    
                Arr = Array("列番号", lCol)
                Call c_Collecction.Add(Arr)     '// データの塊を１カラムのエリアへ
                    
                Arr = Array("色データ_" & lCol, "255,0," & lCol)
                Call c_Collecction.Add(Arr)     '// データの塊を１カラムのエリアへ
                    
                Arr = Array("数式", "=SUM()")
                Call c_Collecction.Add(Arr)     '// データの塊を１カラムのエリアへ
            
            '-------------------------------------------
                Set dat_Collecction = Nothing
            '-------------------------------------------
        
            '// カラムの塊を１行のエリアへ
            Call r_Collecction.Add(c_Collecction)
            
            Set c_Collecction = Nothing
            
        Next lCol
    
        '// 行の塊を全データのエリアへ
        Call all_Collecction.Add(r_Collecction)
        
        Set r_Collecction = Nothing
    Next lRow
    
    
    Debug.Print "行数 : " & all_Collecction.Count
    Debug.Print "列数 : " & all_Collecction.Item(1).Count
    Debug.Print "データ数 : " & all_Collecction.Item(1)(1).Count
    
    '// 1行,2列,3番目データのラベル
    Debug.Print "データ_ラベル : " & all_Collecction.Item(1)(2)(3)(0)
    
    '// 1行,2列,3番目データのデータ
    Debug.Print "データ_Data : " & all_Collecction.Item(1)(2)(3)(1)

End Sub

Collection（Collection（Collection（Array_2D）））

全体：行：列（配列：１次元）：データ詳細（配列：2次元）
※列用Collectionは、Array_2Dを格納する１つだけ

Public Sub mth_Collection_Arr2D()

    Dim all_Collecction As Collection
    Set all_Collecction = New Collection
    
    Dim lRow As Long
    For lRow = 1 To 7   '// ７行
        
        Dim r_Collecction As Collection
        Set r_Collecction = New Collection
        
        Dim lCol As Long
        For lCol = 1 To 5   '// ５列
            Dim c_Collecction As Collection
            Set c_Collecction = New Collection
        
            '============================================
            ' データ詳細（名前付きデータ）
            '============================================
                Dim Arr(3, 1)
                
                Arr(0, 0) = "行番号"
                Arr(0, 1) = lRow
                    
                Arr(1, 0) = "列番号"
                Arr(1, 1) = lCol
                    
                Arr(2, 0) = "色データ_" & lCol
                Arr(2, 1) = "255,0," & lCol
                    
                Arr(3, 0) = "数式" & lCol
                Arr(3, 1) = "=SUM()"
                Call c_Collecction.Add(Arr)     '// データの塊を１カラムのエリアへ
            
            '// カラムの塊を１行のエリアへ
            Call r_Collecction.Add(c_Collecction)
            
            Set c_Collecction = Nothing
            
        Next lCol
    
        '// 行の塊を全データのエリアへ
        Call all_Collecction.Add(r_Collecction)
        
        Set r_Collecction = Nothing
    Next lRow
    
    
    Debug.Print "行数 : " & all_Collecction.Count
    Debug.Print "列数 : " & all_Collecction.Item(1).Count
    Debug.Print "データ数 : " & all_Collecction.Item(1)(1).Count
    
    '// 1行,2列,3番目データのラベル
    '//     最後の要素は１個で２次元配列
    Debug.Print "データ_ラベル : " & all_Collecction.Item(1)(2)(1)(2, 0)
    
    '// 1行,2列,3番目データのデータ
    Debug.Print "データ_Data : " & all_Collecction.Item(1)(2)(1)(2, 1)

End Sub

[検索]文字のアドレスをコレクションで取得

'*************************************************************************
'機能   : [検索]文字のアドレスをコレクションで取得
'戻り値 :
'ARG1   :
'ARG2   :
'説明   :
'*************************************************************************
Private Sub btn_Collect_01_Click()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("debug")

    Dim colRes_Collect As Collection
    Set colRes_Collect = m_検索.mth_GetCellAddress_Sheet(ws, "検索")
    
    Debug.Print colRes_Collect.Count
    
    Dim vFE As Variant
    For Each vFE In colRes_Collect
        Debug.Print vFE
    Next vFE
    
    Set ws = Nothing
    
End Sub


'*************************************************************************
'機能   : シート全体、指定文字列のアドレス検索
'戻り値 : アドレスコレクション
'ARG1   : WorkSheet
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellAddress_Sheet( _
                                            ws As Worksheet, _
                                            sSrhString _
                                            ) As Collection

    Dim sRes_Address() As String
    Dim sRes_Address_Collects As Collection
    Set sRes_Address_Collects = New Collection
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// 検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = ws.Cells.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
    '// 検索不一致時はループを抜ける
        If rngFindCell Is Nothing Then
            Exit Do
        End If

        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    For Each v In rngFind_List
        Call sRes_Address_Collects.Add(v.Address)
    Next
    
    Set mth_GetCellAddress_Sheet = sRes_Address_Collects
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
    Set sRes_Address_Collects = Nothing
    
End Function

コレクション 削除

    '//
    Dim i As Long
    For i = 1 To all_Collecction.Count
        all_Collecction.Remove 1
    Next i

ジャグ構造 ⇒ 矩形構造

'**
'* ジャグ構造 ⇒ 矩形構造
'*
'* parg     {}
'* @arg_ref {}
'* @arg_opt {}
'* @ret     {}
'*
'* @note
'*
Public Sub mth_Collection_ジャグ()

    Dim i As Long
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("コレクション")
    
    Dim lRow_Start  As Long: lRow_Start = 3
    Dim lRow_End    As Long: lRow_End = 16

    '// 参考：行まとめデータ
    Dim Row_Collecction As Collection
    Set Row_Collecction = New Collection
    
    '//
    Dim All_Collecction As Collection
    Set All_Collecction = New Collection
    
    '#######################################################
    Dim lRow As Long
    For lRow = lRow_Start To lRow_End   '// 行範囲
    '#######################################################
        
        '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        ' 指定列：行データ取得
        '   行 → 列 変換データ
        '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        Dim Cell_Dat As Collection
        Set Cell_Dat = New Collection
    
        '============================================
        ' データ詳細（名前付きデータ）
        '============================================
        Dim lCol_Data As Long
        For lCol_Data = 6 To 11
            '-------------------------------------------
                Dim chip_Dat As Collection
            '-------------------------------------------
                Dim rng As Range
                Set rng = ws.Cells(lRow, lCol_Data)
                
'                If rng.Value <> "" Then
                    Set chip_Dat = New Collection       '// 初期化
                        Call chip_Dat.Add(rng.Address)  '// データラベル
                        Call chip_Dat.Add(rng.Value)    '// データ
                    Call Cell_Dat.Add(chip_Dat)         '// 格納
'                End If
                    
            '-------------------------------------------
                Set chip_Dat = Nothing   '// 格納したら、次のために解放
            '-------------------------------------------
        Next lCol_Data
        
        
        '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        ' 行セルデータを列セルデータへ変換（行列変換）:1行分
        '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
        For i = 1 To Cell_Dat.Count
        
            Dim ColToRow As Collection
            Set ColToRow = New Collection
            
            '//##  行番号 ###################
            Set chip_Dat = New Collection   '// 初期化
                Call chip_Dat.Add("RowNo")  '// データラベル
                Call chip_Dat.Add(lRow)     '// データ
                
            '// データペアを格納
            Call ColToRow.Add(chip_Dat)
            
            '//##  Cells(Row,2) ###################
            Set chip_Dat = New Collection                   '// 初期化
                Call chip_Dat.Add("Cells(" & lRow & ",2)")  '// データラベル
                                
                '// データ（空白の場合、１つ上のデータペアと同じにする）
                If lRow = lRow_Start _
                Or Trim(ws.Cells(lRow, 2).Value) <> "" _
                Then
                    Call chip_Dat.Add(ws.Cells(lRow, 2).Value)
                Else
                    Call chip_Dat.Add(All_Collecction.Item(All_Collecction.Count - 1)(ColToRow.Count + 1)(2))
                End If
                
            '// データペアを格納
            Call ColToRow.Add(chip_Dat)
            
            '//##  Cells(Row,3) ###################
            Set chip_Dat = New Collection
                Call chip_Dat.Add("Cells(" & lRow & ",3)")
                
                '// データ（空白の場合、１つ上のデータペアと同じにする）
                If lRow = lRow_Start _
                Or Trim(ws.Cells(lRow, 3).Value) <> "" _
                Then
                    Call chip_Dat.Add(ws.Cells(lRow, 3).Value)
                Else
                    Call chip_Dat.Add(All_Collecction.Item(All_Collecction.Count - 1)(ColToRow.Count + 1)(2))
                End If
            
            Call ColToRow.Add(chip_Dat)
            
            '//##  Cells(Row,4) ###################
            Set chip_Dat = New Collection
                Call chip_Dat.Add("Cells(" & lRow & ",4)")
                
                '// データ（空白の場合、１つ上のデータペアと同じにする）
                If lRow = lRow_Start _
                Or Trim(ws.Cells(lRow, 4).Value) <> "" _
                Then
                    Call chip_Dat.Add(ws.Cells(lRow, 4).Value)
                Else
                    Call chip_Dat.Add(All_Collecction.Item(All_Collecction.Count - 1)(ColToRow.Count + 1)(2))
                End If
            
            Call ColToRow.Add(chip_Dat)
            
            '//##  Cells(Row,5) ###################
            Set chip_Dat = New Collection
                Call chip_Dat.Add("Cells(" & lRow & ",5)")
                Call chip_Dat.Add(ws.Cells(lRow, 5).Value)
            Call ColToRow.Add(chip_Dat)
            
            '//##  行列変換データを１ペアずつ #####################
            Call ColToRow.Add(Cell_Dat.Item(i))
        
            '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
            '$$$ 全データ領域 $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
            '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
            Call All_Collecction.Add(ColToRow)  '// 1レコードずつ
        
        Next i
        
        '// ※行ごとに分割する場合↓
        Call Row_Collecction.Add(ColToRow)  '// 1行ずつ
    
    '#######################################################
    Next lRow
    '#######################################################
    'Collect(Row)(Col)(1):データラベル
    'Collect(Row)(Col)(2):データ
    
    '=====================================
    '// 全データ確認用 表示
    '=====================================
    Dim r As Long
    Dim c As Long
    For r = 1 To All_Collecction.Count
        For c = 1 To All_Collecction.Item(r).Count
            ws.Cells(20 + r, c).Value = All_Collecction.Item(r)(c)(2)
        Next c
    Next r
    
    '=====================================
    '// 空白削除処理
    '=====================================
    Dim DelNoData_Row As Collection
    Set DelNoData_Row = New Collection
    
    For r = 1 To All_Collecction.Count
        
        Dim DelNoData_Col As Collection
        Set DelNoData_Col = New Collection
        For c = 1 To All_Collecction.Item(r).Count
                        
            '// 6列目にデータがあるものを追加
            '// ※行列変換したデータ
            Debug.Print All_Collecction.Item(r)(6)(2)
            If All_Collecction.Item(r)(6)(2) <> "" Then
                Dim Buf As Collection
                Set Buf = New Collection
                    Buf.Add (All_Collecction.Item(r)(c)(1))     '// Collect(Row)(Col)(1):データラベル
                    Buf.Add (All_Collecction.Item(r)(c)(2))     '// Collect(Row)(Col)(2):データ
                Call DelNoData_Col.Add(Buf)
                Set Buf = Nothing
                
            End If
        Next c
        
        If DelNoData_Col.Count > 0 Then
            Call DelNoData_Row.Add(DelNoData_Col)
        Else
            'NOP
        End If
        
        Set DelNoData_Col = Nothing
        
    Next r
    

    '=====================================
    '// 削除済データ確認用 表示
    '=====================================
    For r = 1 To DelNoData_Row.Count
        For c = 1 To DelNoData_Row.Item(r).Count
            ws.Cells(20 + r, c).Offset(0, 8).Value = DelNoData_Row.Item(r)(c)(2)
        Next c
    Next r


End Sub