VBA_二次元配列操作 #VBA

やること

VBAにて二次元配列を作成、操作し、
マクロファイル内のパラメータを二次元配列に格納する関数を作成します。

下記ファイルではシート「表紙」を除いたシートをパラメータシートとします。
パラメータシートをカテゴリごとに分けることで、可読性や保守性を高め、
二次元配列を使用することで、大量にデータを処理する際の時間短縮します。

二次元配列のイメージ

下記のように配列を定義したとします。

Dim Array(1 To 3, 1 To 3)     As Integer

Array(RowMax,ColMax) のように左は行数、右は列数になります。

二次元配列は行と列で構成されており、それぞれのインデックスを指定し値の代入、出力ができます。

インデックスについて

Rangeで指定した範囲を配列に格納すると開始インデックスは1になります。

    Dim sourceRange     As Range
    Dim dataArray       As Variant
    
    'セル範囲を指定
    Set sourceRange = ThisWorkbook.Sheets("Sheet1").Range("A1:C3")
    dataArray = sourceRange.Value

下記のコードのように配列のサイズを指定して定義した場合、仕様により0始まりのインデックスとなります。

Dim arr(2,2)          As Variant

関数_fncGetParameter

パラメータシートの情報を取得し、二次元配列に格納する処理を作成していきます。

引数、戻り値について

引数
列と行はそれぞれ番号とし、Forで配列を作成しやすくしています。

Function fncGetParameter( _
    ByVal strwkb As String, _
    ByVal strSht As String, _
    ByVal lngRowMin As Long, _
    ByVal lngRowMax As Long, _
    ByVal intColMin As Integer, _
    ByVal intColMax As Integer, _
    ByRef RstrMsgPrompt As String, _
    ByRef RintRet As Integer _
    )

・ByVal strwkb As String：ワークブック名
・ByVal strSht As String：ワークシート名
・ByVal lngRowMin As Long：データ開始行番号
・ByVal lngRowMax As Long：データ終了行番号
・ByVal intColMin As Integer：データ開始列番号
・ByVal intColMax As Integer：データ終了列番号
・ByRef RstrMsgPrompt As String：エラー文言格納用
・ByRef RintRet As Integer：エラー番号格納用

戻り値
作成した配列を返します。シートや処理によって行番号は異なることを想定し、サイズは指定しません。

    Dim RvarArr()       As Variant
    fncGetParameter = RvarArr()

最下行の取得

受け取ったデータ終了行番号が0の場合、データ終了行番号を取得します。
定数を0と定義して関数に渡すことで、行数の変更に対応します。

    If 0 = lngRowMax Then
        lngRowMax = Cells(Rows.Count, intColMin).End(xlUp).Row
    End If

最終列の取得

受け取ったデータ終了列番号が0の場合に終了列番号を取得します。
行番号と同じく開始番号から終了番号間に空白セルが含まれている場合でも、
空白セルを含む範囲を格納対象とします。

    If 0 = intColMax Then
        intColMax = Cells(lngRowMin, Columns.Count).End(xlToLeft).Column
    End If

配列の再定義

ReDimを使用し配列のサイズを指定します。

ReDim RvarArr(intColMax - intColMin, lngRowMax - lngRowMin)

配列の作成

引数で受け取ったブックのシートからセルの値を取得し、再定義した配列に代入します。

    Dim LlngRowCnt      As Long
    Dim LintColCnt      As Integer
    Dim wkb             As Workbook
    Dim wks             As Worksheet

    For LlngRowCnt = 0 To (lngRowMax - lngRowMin)
        For LintColCnt = 0 To (intColMax - intColMin)
            RvarArr(LlngRowCnt, LintColCnt) = wks.Cells(lngRowMin + LlngRowCnt, _
                                                        intColMin + LintColCnt)
        Next LintColCnt
    Next LlngRowCnt

サンプル

組み合わせて関数とすると下記のようになります。

Function fncGetParameter( _
    ByVal strWkb As String, _
    ByVal strWks As String, _
    ByVal lngRowMin As Long, _
    ByVal lngRowMax As Long, _
    ByVal intColMin As Integer, _
    ByVal intColMax As Integer, _
    ByRef RstrMsgPrompt As String, _
    ByRef RintRet As Integer _
    )
    
    '初期設定
    On Error GoTo Err01
    
    '変数定義
    Dim LlngRowCnt      As Long
    Dim LintColCnt      As Integer
    Dim RvarArr()       As Variant
    Dim wkb             As Workbook
    Dim wks             As Worksheet
    
    '初期設定
    Set wkb = Workbooks(strWkb)
    Set wks = ThisWorkbook.Sheets(strWks)

    '最下行取得
    wks.Activate
    If 0 = lngRowMax Then
        lngRowMax = Cells(Rows.Count, intColMin).End(xlUp).Row
    End If

    '最終列取得
    If 0 = intColMax Then
        intColMax = Cells(lngRowMin, Columns.Count).End(xlToLeft).Column
    End If

    '配列再定義
    ReDim RvarArr(intColMax - intColMin, lngRowMax - lngRowMin)

    '配列作成
    For LlngRowCnt = 0 To (lngRowMax - lngRowMin)
        For LintColCnt = 0 To (intColMax - intColMin)
            RvarArr(LlngRowCnt, LintColCnt) = wks.Cells(lngRowMin + LlngRowCnt, _
                                                        intColMin + LintColCnt)
        Next LintColCnt
    Next LlngRowCnt
    
    fncGetParameter = RvarArr()
    
    Exit Function
    
Err01:
    RintRet = Err.Number
    RstrMsgPrompt = "エラー番号：" & RintRet & vbCrLf & _
                    "エラー内容：" & Err.Description

End Function

結果：

関数_fncGetArray

上記のパラメータシートの内容を格納した配列より、キーを指定し特定の区分の行を抽出し、
使用したい行のみを格納した配列を作成します。

引数、戻り値について

引数

Function fncGetArray( _
    ByVal varArray As Variant, _
    ByVal strKey As String, _
    ByVal intCriteriaCol As Integer, _
    ByRef RintRet As Integer, _
    ByRef RstrMsgPrompt As String _
    )

・ByVal varArray As Variant：抽出元の配列
・ByVal strKey As String：検索値
・ByVal intCriteriaCol As Integer：基準列番号
・ByRef RintRet As Integer：エラー番号格納用
・ByRef RstrMsgPrompt As String：エラー文言格納用

戻り値
受け取った配列から抽出した結果を配列で返します。

    Dim RvarArr()       As Variant
    fncGetArray = RvarArr()

条件に当てはまる行をカウントし、配列のサイズを指定する

ReDim Preserveステートメントは、既存の値を保持しサイズを変更できますが、1次元（行）を動的に増やすことができません。
下記のコードでは基準列にキーが含まれる件数をカウントし、配列の行数がいくつになるのか予め取得しています。

    RowCnt = 0
    For LlngRowCnt = 0 To UBound(varArray, 1)
        If strKey = varArray(LlngRowCnt, intCriteriaCol) Then
            RowCnt = RowCnt + 1
        End If
    Next LlngRowCnt

サンプル

    Dim arr() As Variant
    arr() = fncGetArray(GvarListFile, "入力", 0, RintRet, RstrMsgPrompt)

組み合わせて関数とすると下記のようになります。

Function fncGetArray( _
    ByVal varArray As Variant, _
    ByVal strKey As String, _
    ByVal intCriteriaCol As Integer, _
    ByRef RintRet As Integer, _
    ByRef RstrMsgPrompt As String _
    )

    '初期設定
    On Error GoTo Err01
    
    '変数定義
    Dim LlngRowCnt      As Long
    Dim LintColCnt      As Integer
    Dim RvarArr()       As Variant
    Dim RowCnt          As Long
    
    '行数取得
    RowCnt = 0
    For LlngRowCnt = 0 To UBound(varArray, 1)
        If strKey = varArray(LlngRowCnt, intCriteriaCol) Then
            RowCnt = RowCnt + 1
        End If
    Next LlngRowCnt
    
    '配列再定義
    ReDim RvarArr(RowCnt - 1, UBound(varArray, 2))

    '配列作成
    RowCnt = 0
    For LlngRowCnt = 0 To UBound(varArray, 1)
        If strKey = varArray(LlngRowCnt, intCriteriaCol) Then
            For LintColCnt = 0 To UBound(varArray, 2)
                RvarArr(RowCnt, LintColCnt) = varArray(LlngRowCnt, LintColCnt)
            Next LintColCnt
            RowCnt = RowCnt + 1
        End If
    Next LlngRowCnt
    fncGetArray = RvarArr()
    
    Exit Function

Err01:
    RintRet = Err.Number
    RstrMsgPrompt = "エラー番号：" & RintRet & vbCrLf & _
                    "エラー内容：" & Err.Description

End Function

結果：

おわりに

二次元配列の基本的な操作と使用例について取り扱いました。
動作を確認しつつ保守性の高い関数にできたらと思います。

参考：
https://learn.microsoft.com/ja-jp/office/vba/language/concepts/getting-started/using-arrays

エンジニアファーストの会社株式会社CRE-CO S.K