きなこSHOW

VBAと日々の戯言

Excel VBAで指定した範囲の値を配列に格納するサンプル

セル範囲に入力されたデータを配列に格納するテクニックをご存知でしょうか。
VBA処理の高速化に役立つ技で、頻繁に使われています。
今回そいつを汎用的に使えるように関数化しました。
コピーしてそのまま使えるサンプルプログラムを公開します。

なぜ配列化?

セル範囲を配列に格納するテクニックは、多くのサイトで説明されています。
VBAの権威、ゴッドオブVBAの田中先生も仰ってますが、これ究極の方法です。

Office TANAKA - Excel VBA高速化テクニック[セルを配列に入れる]

何が良いかって、Excel Sheetから取得と貼り付けるだけなら各要素をループする必要がなく、個々のセルでの評価も発生しないため、高速処理が可能となるのです。

セルを配列に入れるサンプルコード

セル範囲のデータを配列に格納するにはまず、セルの範囲を特定してやる必要があります。
処理対象のセル範囲が常に一定であれば、Rangeプロパティを使用した次の構文で大丈夫です。

Dim vTestArray As Variant
vTestArray = Worksheets("Test").Range("A3:Z5000")

しかし実際の業務では、行数や時には列数が一定ではない場合も多くあることでしょう。
Rangeだけでは行・列を可変とすることはできないので、上の構文は使えません。
セル範囲の左上端と右下端を数値で指定する場合は、Cellsプロパティを使用して以下のように記述します。

Dim vTestArray As Variant
With Worksheets("Test")
     vTestArray = .Range(.Cells(先頭行, 先頭列), .Cells(最終行, 最終列))
End With

結局毎回これを繰り返し書いていて面倒だったので、部品化して使いまわしています。
それが以下のプロシージャです。

しつこいかと思いますが、サンプルコードの使用はすべて自己責任でお願いいたしますね。

'**************************************************
'名称 :F_GetArrayRange 指定範囲のデータを配列で返す
'引数 :robjSheet      (I ) Worksheet
'   :vlRowMax       (I ) Long:行番号To
'   :vlColMax       (I ) Long:列番号To
'   :vlRowMin       (I ) Long:行番号From
'   :vlColMin       (I ) Long:列番号From
'   :rvReturn       ( O) Variant:(返却用)配列
'   :rsMsg          ( O) String:エラーメッセージ
'戻り値:True=成功, False=どこかでエラーになった
'作成 :Kinaccco
'**************************************************
Public Function F_GetArrayRange(ByRef robjSheet As Worksheet _
                              , ByVal vlRowMax As Long _
                              , ByVal vlColMax As Long _
                     , Optional ByVal vlRowMin As Long = 1 _
                     , Optional ByVal vlColMin As Long = 1 _
                     , Optional ByRef rvReturn As Variant = "" _
                     , Optional ByRef rsMsg As String = "") As Boolean
On Error GoTo Sub_Err
Dim lbRet           As Boolean
Dim llRowsCount     As Long
Dim llColumnsCount  As Long
Dim lvArray         As Variant

    '--- 初期値セット ---
    lbRet = False
    rsMsg = ""
    
    '--- パラメータチェック ---
    If robjSheet Is Nothing Then
        rsMsg = "[ERR-01]Worksheet参照の受け渡しに失敗しました"
        GoTo Sub_Exit
    End If
    If vlRowMax <= 0 Then
        rsMsg = "[ERR-02]範囲最終行の受け渡しに失敗しました"
        GoTo Sub_Exit
    End If
    If vlColMax <= 0 Then
        rsMsg = "[ERR-03]範囲最終列の受け渡しに失敗しました"
        GoTo Sub_Exit
    End If
    If vlRowMin <= 0 Then
        rsMsg = "[ERR-04]範囲先頭行の受け渡しに失敗しました"
        GoTo Sub_Exit
    End If
    If vlColMin <= 0 Then
        rsMsg = "[ERR-05]範囲先頭列の受け渡しに失敗しました"
        GoTo Sub_Exit
    End If
    
    '--- シートの最大行・列を取得する ---
    With robjSheet
        llRowsCount = .Rows.Count
        llColumnsCount = .Columns.Count
    End With
    
    '--- 行・列番号チェック ---
    If vlRowMin > llRowsCount Then
        rsMsg = "範囲先頭行の値が正しくありません(" & CStr(llRowsCount) & "を超える)"
        GoTo Sub_Exit
    End If
    If vlRowMax > llRowsCount Then
        rsMsg = "範囲最終行の値が正しくありません(" & CStr(llRowsCount) & "を超える)"
        GoTo Sub_Exit
    End If
    If vlColMin > llColumnsCount Then
        rsMsg = "範囲先頭列の値が正しくありません(" & CStr(llColumnsCount) & "を超える)"
        GoTo Sub_Exit
    End If
    If vlColMax > llColumnsCount Then
        rsMsg = "範囲最終行の値が正しくありません(" & CStr(llColumnsCount) & "を超える)"
        GoTo Sub_Exit
    End If
    
    '--- 指定範囲の値を取得する ---
    With robjSheet
        lvArray = .Range(.Cells(vlRowMin, vlColMin), .Cells(vlRowMax, vlColMax))
    End With
    If IsArray(lvArray) = False Then GoTo Sub_Exit
    
    '--- 返却用変数に格納する ---
    rvReturn = lvArray
    
    '--- 正常終了 ---
    lbRet = True

Sub_Exit:
On Error Resume Next

    F_GetArrayRange = lbRet
        
    Exit Function

Sub_Err:
    rsMsg = "予期せぬエラーが発生しました" & vbCrLf & _
        "プロシージャ名:F_GetArrayRange" & vbCrLf & _
        "エラー番号:" & Err.Number & vbCrLf & _
        "エラー内容:" & Err.Description
    GoTo Sub_Exit

End Function

エラーは事前に必ずとらえて後続の処理に進ませないためにチェックはしつこくしています。
チェック部分が要らない場合は適宜削除してください。
このチェック部分をすべて削除した場合、RangeをVariantに格納するだけになるんで、関数化のメリットがないんですけどね。

呼び出し例

この関数の使い方をサンプルでご紹介します。
例えばこんな表があったとして、
サンプルデータ
この表のデータを配列に格納するには次のように記述します。

Set objSheet = ThisWorkbook.Worksheets("公安局刑事課")

    '--- データが入力されている最大行・列を取得する ---
    If F_GetRowMax(objSheet, , lRowMax, sMsg) = False Then
        If Len(sMsg) <= 0 Then sMsg = "シート(" & objSheet.Name & ")からの最大行の取得に失敗しました"
        GoTo Sub_Exit
    End If
    If F_GetColMax(objSheet, , lColMax, sMsg) = False Then
        If Len(sMsg) <= 0 Then sMsg = "シート(" & objSheet.Name & ")からの最大列の取得に失敗しました"
        GoTo Sub_Exit
    End If
    
    '--- シートに入力された値を配列に取得する ---
    If F_GetArrayRange(objSheet, lRowMax, lColMax, , , vArray, sMsg) = False Then
        If Len(sMsg) <= 0 Then sMsg = "シート(" & objSheet.Name & ")からのデータの取得に失敗しました"
        GoTo Sub_Exit
    End If
    
    '--- 取得したデータの確認 ---
    For i = 1 To UBound(vArray, 1)
        For j = 1 To UBound(vArray, 2)
            Debug.Print vArray(i, j), ;
        Next j
        Debug.Print ""
    Next i

Sub_Exit:
On Error Resume Next

	'--- 後片付け ---
    Set objSheet = Nothing

ExcelのRangeオブジェクトをVariant型の変数に代入すると、二次元配列の形式で格納されます。扱い方が手軽な上に、処理も高速です。
行数や列数が可変の場合は、範囲を取得するために最終行と最終列を特定する必要がありますので、前回紹介した関数を呼び出しています。
行数や列数が固定の場合は固定値を与えてやればよいので、サブプロシージャの呼び出しは省略可能です。
返された配列の最小の要素は行・列ともにゼロなんだけど、Excelの行番号、列番号に合わせて要素番号1から値が入ってきますので、そこだけは注意が必要です。

上のサンプルコードで表示された結果が以下。

サンプル実行結果
このサンプルではイミディエイトウィンドウに表示しています。

貼り付け処理のサンプル

もうひとつ、Variant変数に格納されている配列をExcel Sheetのセル範囲に貼り付ける短いサンプルを紹介します。

Set objSheet = ThisWorkbook.Worksheets("Sheet1")
With objSheet
    '--- 明細出力 ---
    .Range(.Cells(llRowHead + 1, 1), .Cells(llRowHead + llRecordCNT, llFieldsCNT)) = vvArray
End With

左上端の1セルだけ指定しても配列のすべての値が一括で貼り付けできますが、貼り付け範囲を正確にコントロールしたければ、貼り付け先の行数、列数を指定した方が良いでしょう。


多くの用途で使えるテクニックなので、業務や用途に合わせて使ってみてください。
これまでご紹介したデータの最終行、最終列の取得と、今日紹介した範囲配列取得関数の合わせ技で、簡単楽チンにExcelデータを取得&貼り付けできるサンプルコードでした。

お役に立てれば。