[Excel VBA] Rangeオブジェクトの2次元配列の作成

指定のセル範囲の各Rangeオブジェクトを２次元配列に格納

Public Function CreateRangeArray( _
        TargetRange As Range, _
        RangeArray() As Range, _
        Optional BaseIndex As Long = 0 _
    )

    If Not TypeOf TargetRange Is Range Then
        CreateRangeArray = 1
        Exit Function
    End If

    If BaseIndex < 0 Then
        CreateRangeArray = 2
        Exit Function
    End If

    Dim RowList As Object, ColList As Object
    Set RowList = CreateObject("System.Collections.SortedList")
    Set ColList = CreateObject("System.Collections.SortedList")

    Dim Cell As Range
    For Each Cell In TargetRange.Cells
        If Not RowList.ContainsKey(Cell.Row) Then
            Call RowList.Add(Cell.Row, 0)
        End If
        If Not ColList.ContainsKey(Cell.Column) Then
            Call ColList.Add(Cell.Column, 0)
        End If
    Next

    ReDim RangeArray( _
            0 + BaseIndex To RowList.Count - 1 + BaseIndex, _
            0 + BaseIndex To ColList.Count - 1 + BaseIndex _
        ) As Range

    Dim r As Long, c As Long
    For Each Cell In TargetRange.Cells
        r = RowList.IndexOfKey(Cell.Row)
        c = ColList.IndexOfKey(Cell.Column)
        Set RangeArray(r + BaseIndex, c + BaseIndex) = Cell
    Next

    CreateRangeArray = 0

End Function