二次元配列の一部を一次元配列として抽出する関数 - Infomentのブログ～Excel VBA奮闘記～

複数行複数列の表を、丸ごと二次元配列に格納することがあります。
さらに、そのまま使用することもあれば、行列内の指定行または指定列のみに対し、何某かの処理をすることもあります。

そこで特定の行または列を、新たに一次元配列として抽出する関数を作成してみました。

'===============================================================================
' Name     : ExtractArray
' Input    :
'   seq As Variant       抽出したい要素を含む二次元配列
'   row_Index    As Long 抽出する行番号
'   column_Index As Long 抽出する列番号
' Output   :
'   正常終了・・・抽出した配列
'   -1の場合・・・異常終了：指定したseqが配列ではない。
'   -2の場合・・・異常終了：指定した配列が二次元ではない。
'   -3の場合・・・異常終了：指定した列番号が、配列の範囲を超えている。
'   -4の場合・・・異常終了：上記以外のエラー（指定した列番号がマイナスの値、など）。
' Purpose  : 二次元配列から指定した列を、一次元配列として抽出。
' Remarks  : 行と列を同時に指定した場合、行が優先される。
' Author   : infoment　（https://infoment.hatenablog.com/entry/2018/07/22/065637）
' Start    : 2018/07/22
' Version  : 1.1
'===============================================================================

Function ExtractArray(seq As Variant, _
                        Optional row_Index As Long = -1, _
                        Optional column_Index As Long = 1) As Variant

    Dim myFlag As Boolean
        On Error GoTo er1:
        If IsArray(seq) = False Then
            ExtractArray = -1
        ElseIf GetArrayDimension(seq) <> 2 Then
            ExtractArray = -2
        ElseIf column_Index > UBound(seq, 2) Then
            ExtractArray = -3
        Else
            myFlag = True
        End If
        If myFlag = False Then Exit Function

    Dim i   As Long
    Dim Col As Collection
        Set Col = New Collection    
        Select Case row_Index
            Case -1
                For i = LBound(seq, 1) To UBound(seq, 1)
                    Col.Add seq(i, column_Index)
                Next i
            Case Else
                For i = LBound(seq, 2) To UBound(seq, 2)
                    Col.Add seq(row_Index, i)
                Next i
        End Select
    
    Dim buf() As Variant    
        ReDim buf(Col.Count - 1)
        For i = 1 To Col.Count
            buf(i - 1) = Col.Item(i)
        Next        
        ExtractArray = buf
        Exit Function
        
er1:
        ExtractArray = -4
End Function

なお、この関数は、先日紹介した「配列の次元数を確認する関数」と併せて使用します。

Function GetArrayDimension(seq As Variant) As Integer
    ' 配列か否かの判定。    
        If IsArray(seq) = False Then
            GetArrayDimension = -1
            Exit Function
        End If    
    ' 配列の次元数を取得。    
    Dim i       As Long
    Dim temp    As Variant    
        On Error Resume Next
        Do While Err.Number = 0
            i = i + 1
            temp = UBound(seq, i)
        Loop        
        GetArrayDimension = i - 1
End Function

使用例として、昨日の表から行および列を抽出してみました。

f:id:Infoment:20180722063434p:plain

Sub test()
    Dim seq1 As Variant
    seq1 = Selection
    
    Dim seq2 As Variant
    seq2 = ExtractArray(seq1, 2)
    
    Dim seq3 As Variant
    seq3 = ExtractArray(seq1, , 3)
    
    MsgBox Join(seq2, vbLf)
    MsgBox Join(seq3, vbLf)
End Sub