やること
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