コレクションオブジェクト


◎これだけ便利であるにもかかわらず、使いこなしている人が少ないという
不思議なオブジェクトがコレクションです。
個人的にRangeオブジェクトを使用したExcel固有の書き方は好きではないので、
書き換えの必要のないものはCollectionを多用しています。
Variantとの相互変換による行列変換がキモです。


Option Explicit

Sub main()
'"test"シートにあるデータをコレクションに入れてからクリアしてみます
'この短いプロシージャにEXCEL VBAのエッセンスが詰まっています
    Dim wksSheet As Worksheet
    Dim lngRow As Long
    Dim lngClm As Long
    Dim lngRowMax As Long
    Dim lngClmMax As Long
    Dim varBuf As Variant
    Dim colList As Collection
    Dim sheetName As String
    
    sheetName = "test"
    
    Set wksSheet = Worksheets(sheetName)
    
    lngRowMax = wksSheet.UsedRange.Rows.Count
    lngClmMax = wksSheet.UsedRange.Columns.Count
    
    'コレクションを宣言
    Set colList = New Collection
    '列ごとVariantに入れた後にコレクションに追加
    For lngClm = 1 To lngClmMax Step 1
        varBuf = wksSheet.Range(wksSheet.Cells(1, lngClm), wksSheet.Cells(lngRowMax, lngClm)).Value
        colList.Add varBuf
    Next
    
    wksSheet.Range(wksSheet.Cells(1, 1), wksSheet.Cells(lngRowMax, lngClmMax)).Clear
    
    
    If IsArray(varBuf) = True Then
        Erase varBuf
    End If
    
    Set wksSheet = Nothing
    Set colList = Nothing
End Sub

Public Sub Reset()
'"src"シートにあるデータを"test"シートにコピーします
'これもコレクションの使い方の代表例です
    Dim wksSheet As Worksheet
    Dim lngClm As Long
    Dim lngRowMax As Long
    Dim lngClmMax As Long
    Dim varBuf As Variant
    Dim colList As Collection
    Dim sheetName
    
    sheetName = "src"
    
    Set wksSheet = Worksheets(sheetName)
    
    lngRowMax = wksSheet.UsedRange.Rows.Count
    lngClmMax = wksSheet.UsedRange.Columns.Count
    Set colList = New Collection
    For lngClm = 1 To lngClmMax Step 1
        varBuf = wksSheet.Range(wksSheet.Cells(1, lngClm), wksSheet.Cells(lngRowMax, lngClm)).Value
        colList.Add varBuf
    Next
    
    Set wksSheet = Nothing
    
    sheetName = "test"
    
    Set wksSheet = Worksheets(sheetName)
    
    'コレクション内部で要素が列単位になっているので
    '一度Variantに入れたから行列を入れ替えます。
    For lngClm = 1 To colList.Count Step 1
        If IsArray(varBuf) = True Then Erase varBuf
        varBuf = colList.Item(lngClm)
        wksSheet.Range(wksSheet.Cells(1, lngClm), wksSheet.Cells(UBound(varBuf), lngClm)) = varBuf
    Next
    
    If IsArray(varBuf) = True Then
        Erase varBuf
    End If
    Set wksSheet = Nothing
    Set colList = Nothing
End Sub