EXCEL VBA 　2次元配列・セル範囲の内容を配列に格納・配列の内容をセルに代入（一括・高速化・セルの指定範囲）

2020年9月12日

EXCEL VBA 　2次元配列・セル範囲の内容を配列に格納・配列の内容をセルに代入（一括・高速化・セルの指定範囲）

●はじめに

今回、説明するサンプルプログラムは、2次元配列を利用して、指定したセルの範囲内容を一括に配列へ格納して、格納した配列内容を一括にセルへ代入（貼り付け）するサンプルプログラムです。また、2次元配列に格納したデータを配列内で変更・入替・計算結果を格納するなど、2次元配列をワークシートの様に扱う方法も併せて説明いたします。

●【配列の基礎については、下記を参照して下さい】

EXCEL VBA 配列の使い方(Array LBound UBound)

●【連想配列を利用したクロス集計については、下記の参照して下さい】

EXCEL VBA 連想配列でクロス集計・項目別集計・グループ集計 (Scripting.Dictionary)　テクニック

●書式の説明　（2次元配列）

●2次元配列を利用する場合は、下記の通りに宣言します。(宣言例)

宣言	説明
Dim 配列名	配列名のみ設定します。
Dim 配列名()　As Variant	Variant形式で宣言します。
Dim 配列名（1 To 10,1 To 3）	2次元配列を縦10行・横3列に指定
Dim 配列名（10,3）	2次元配列を縦0～10行・横0～3列に指定※注意・配列の番号が0～10となるので、11行になります。

【使用例（サンプルプログラム）】
下記の２つの使用例（サンプルプログラム）は、Aパターン・Bパターン共に結果は同じ処理を行います。
Aパターンの場合は、セル範囲を選択して、一括に配列に読み取り（格納）別のセルに転記しています。
Bパターンの場合は、セル範囲から２次元配列へデータをひとつずつ登録（格納）して、登録された配列からセルにひとつずつセルに転記します。処理の方法は、Aパターンの方がプログラムも短く簡単ですが、２次元配列を覚えるには、Bパターンの方が重要です。

【パターンA】

'
Sub Array00A() 'Aパターン（２次元配列）
    
    Dim TempData   
    TempData = Range("A1:c10").Value 'セルA1:C10までを２次元配列に登録（格納）
    Range("D1:F10").Value = TempData '登録した２次元配列からセルD1：F10へ転記します。

End Sub
'

Sub Array00A() 'Aパターン（２次元配列）

Dim TempData

TempData = Range("A1:c10").Value 'セルA1:C10までを２次元配列に登録（格納）

Range("D1:F10").Value = TempData '登録した２次元配列からセルD1：F10へ転記します。

End Sub

【パターンB】

'
Sub Array00B() 'Bパターン（２次元配列）

    Dim TempData(1 To 10, 1 To 3)
    Dim Y, X As Integer
    
    For Y = 1 To 10  'セル1行目～10行目まで繰り返す。
        For X = 1 To 3  'セル１列目（A）～3列目まで繰り返す。
            TempData(Y, X) = Cells(Y, X).Value 'セルA1:C10までを２次元配列に登録（格納）します。
        Next X
    Next Y

    
    For Y = 1 To 10  '配列（縦）１行～10行まで繰り返す。
        For X = 1 To 3  '配列（横）1列～3列まで繰り返す。
            Cells(Y, 3 + X).Value = TempData(Y, X) '登録した２次元配列からセルD1：F10へ転記します。
        Next X
    Next Y

End Sub
'

Sub Array00B() 'Bパターン（２次元配列）

Dim TempData(1 To 10, 1 To 3)

Dim Y, X As Integer

For Y = 1 To 10 'セル1行目～10行目まで繰り返す。

For X = 1 To 3 'セル１列目（A）～3列目まで繰り返す。

TempData(Y, X) = Cells(Y, X).Value 'セルA1:C10までを２次元配列に登録（格納）します。

Next X

Next Y

For Y = 1 To 10 '配列（縦）１行～10行まで繰り返す。

For X = 1 To 3 '配列（横）1列～3列まで繰り返す。

Cells(Y, 3 + X).Value = TempData(Y, X) '登録した２次元配列からセルD1：F10へ転記します。

Next X

Next Y

End Sub

●【パターンA】・【パターンB】のプログラム実行中の2次元配列の中身は下図の通りです。

【配列の中身を表示するには、ローカルウィンドを選択します】

2次元配列に取り込んだ格納データを計算して、格納された計算結果をセルに転記します。（配列内の計算）

●プログラム説明　（サンプル①）2次元配列内の計算

下記のサンプルプログラムは、2次元配列に取り込んだ格納データを計算して、計算結果を配列に格納され、配列に格納された計算結果をセルに転記するサンプルプログラムです。

●実際に配列（TempData）の中身を見てみましょう。
【解説】TempData・・・は、2次元データ全体を表しています。
TempData（1,1） 100 が格納されています。
TempData（1,2) 200が格納されています。
TempData（1,1）+TempData（1,2) =TempData(1,3) 計算結果が「TempData（1,3）」に格納されている事が解ります。

'
''******** AKIRA55.COM *******  https://akira55.com/array02_tec/
'
Sub Array01() '2次元配列に取り込んだ格納データを計算して、格納された計算結果をセルに転記します。
    
    Dim TempData
    Dim I As Long
     
    TempData = Range("A1:C10").Value  'セルA1：C10の内容を2次元配列に格納します。
    
    For I = LBound(TempData, 1) To UBound(TempData, 1)  '2次元配列データの縦　　～　最終配列まで繰り返します。
        
        TempData(I, 3) = TempData(I, 1) + TempData(I, 2)  '２次元配列の１列目と2列名を加算して、結果を3列目に格納します。
        
    Next I
   
    Range("D1:F10").Value = TempData  '計算された2次元配列データを指定したセルに貼り付けます。

End Sub
'

''******** AKIRA55.COM ******* https://akira55.com/array02_tec/

Sub Array01() '2次元配列に取り込んだ格納データを計算して、格納された計算結果をセルに転記します。

Dim TempData

Dim I As Long

TempData = Range("A1:C10").Value 'セルA1：C10の内容を2次元配列に格納します。

For I = LBound(TempData, 1) To UBound(TempData, 1) '2次元配列データの縦　　～　最終配列まで繰り返します。

TempData(I, 3) = TempData(I, 1) + TempData(I, 2) '２次元配列の１列目と2列名を加算して、結果を3列目に格納します。

Next I

Range("D1:F10").Value = TempData '計算された2次元配列データを指定したセルに貼り付けます。

End Sub

●実行前～実行後　※プログラム実行後、セル（A1:C10）の値を２次元配列へ格納して、1列目と2列目の配列を計算（3列目：足し算）します。計算結果を含めてセル（D１：F10）へ転記されました。
（画面クリックして拡大）

2つの2次元配列を利用してデータの受け渡し及び、判定結果・計算結果を別の2次元配列に格納する。

●プログラム説明　（サンプル②）2次元配列内の計算及び条件判定・複数の２次元配列　

下記のサンプルプログラムは、２つの2次元配列を利用してデータを別の配列へ受け渡しを行い、配列の計算を行い計算結果を元に判定を行い結果を配列に格納します。最後に、指定したセル範囲に結果を転記します。

【プログラムの説明・処理手順】
①セル（A2:C11）のセル内容をTempData０１（2次元配列）へ格納します。（縦10×横３）
②TempData02（2次元配列）を再定義します。（縦10×横５）
③TempData01　⇒　TempData02 へ配列内データを転記します。
④配列内のデータを転記する際に、国語・数学の点を合計してTempData02へ４列目に転記します。
⑤TempData02へ４列目の合計点を元に、110以上で合格・110未満で不合格とTempData02へ５列目に判定します。
⑥最後に、TempData02の配列データをセルE2よりデータを貼り付けます。

'
''******** AKIRA55.COM ******* https://akira55.com/array02_tec/
'
Sub Array02()  '2つの2次元配列を利用してデータの受け渡し及び、判定結果・計算結果を別の2次元配列に格納する。

    Dim TempData01, TempData02
    Dim I As Long
    
    
    TempData01 = Range("A2:C11").Value 'セルA2：C11の内容を2次元配列（TempData01）「縦10×横3」に格納します。

    ReDim TempData02(1 To 10, 1 To 5)  '計算結果及び判定結果用の2次元配列を作成（TempData02）「縦10×横5」
    
    For I = LBound(TempData01, 1) To UBound(TempData01, 1) '2次元配列（TempData01）に格納されたデータの1件目から最終まで繰り返す。
        
        TempData02(I, 1) = TempData01(I, 1)  '2次元配列データの転記（TempData01⇒TempData02）
        TempData02(I, 2) = TempData01(I, 2)
        TempData02(I, 3) = TempData01(I, 3)
        TempData02(I, 4) = TempData01(I, 2) + TempData01(I, 3)  '2次元配列データの計算（TempData01+TempData01＝計算結果TempData02）
        If TempData02(I, 4) >= 110 Then        '計算結果を判定（70を超える場合は合格・それ以外は不合格）
                TempData02(I, 5) = "合格"
            Else
                TempData02(I, 5) = "不合格"
        End If
    
    Next I

    Range("E2").Resize(UBound(TempData02, 1), 5) = TempData02  '2次元配列（TempData02）の結果（計算・判定）をセル（D1：より）に転記します。

End Sub
'

''******** AKIRA55.COM ******* https://akira55.com/array02_tec/

Sub Array02() '2つの2次元配列を利用してデータの受け渡し及び、判定結果・計算結果を別の2次元配列に格納する。

Dim TempData01, TempData02

Dim I As Long

TempData01 = Range("A2:C11").Value 'セルA2：C11の内容を2次元配列（TempData01）「縦10×横3」に格納します。

ReDim TempData02(1 To 10, 1 To 5) '計算結果及び判定結果用の2次元配列を作成（TempData02）「縦10×横5」

For I = LBound(TempData01, 1) To UBound(TempData01, 1) '2次元配列（TempData01）に格納されたデータの1件目から最終まで繰り返す。

TempData02(I, 1) = TempData01(I, 1) '2次元配列データの転記（TempData01⇒TempData02）

TempData02(I, 2) = TempData01(I, 2)

TempData02(I, 3) = TempData01(I, 3)

TempData02(I, 4) = TempData01(I, 2) + TempData01(I, 3) '2次元配列データの計算（TempData01+TempData01＝計算結果TempData02）

If TempData02(I, 4) >= 110 Then '計算結果を判定（70を超える場合は合格・それ以外は不合格）

TempData02(I, 5) = "合格"

Else

TempData02(I, 5) = "不合格"

End If

Next I

Range("E2").Resize(UBound(TempData02, 1), 5) = TempData02 '2次元配列（TempData02）の結果（計算・判定）をセル（D1：より）に転記します。

End Sub

●実行前～実行後　※プログラム実行後、２つの2次元配列を利用してデータを転記・配列内の計算・計算結果による判定を行い、指定したセル位置に、2次元配列のデータが転記されました。
（画面クリックして拡大）

２つの2次元配列の利用して、データの受け渡し及びデータ抽出を行い、結果をシートに転記する。

●プログラム説明　（サンプル③）2次元配列間でのデータ抽出・別シートに転記

下記のサンプルプログラムは、2つの２次元配列を利用して、データの受け渡し及び選択したデータの抽出を行い、データの抽出結果を別シートに転記するサンプルプログラムです。

【プログラムの説明・処理手順】
①ワークシート【人事データ】のセル（A2:H21）のセル内容をTempData０１（2次元配列）へ格納します。（縦20×横8）
②TempData02（2次元配列）を再定義します。（縦20×横８）
③TempData01　⇒　TempData02 へ配列内データを転記します。④の条件で転記
④配列内のデータを転記する際に、性別【男】かつ年齢【45歳未満】に該当するデータをTempData02へ転記します。
⑤最後に、TempData02の配列データをワークシート【】のセルA2よりデータを貼り付けます。

【プログラム実行条件】
ワークシート名を【人事データ】
ワークシート名を【抽出リスト】

'
''******** AKIRA55.COM ******* https://akira55.com/array02_tec/
'
Sub Array03()  '２つの2次元配列の利用して、データの受け渡し及びデータ抽出を行い、結果をシートに転記する。

    Dim ws01, ws02 As Worksheet
    Dim TempData01, TempData02
    Dim I, L, lRow As Long
    

    Set ws01 = Worksheets("人事データ") 'ワークシート「人事データ」
    Set ws02 = Worksheets("抽出リスト") 'ワークシート「抽出リスト」

     
    
    L = 1 '2次元配列データ（初期位置）
    lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row    'シート「人事データ」A列の最終行を取得
    
    TempData01 = ws01.Range("A2:H" & lRow).Value  'シート「人事データ」のデータを2次元配列「TempData01」へ全て格納します。

    ReDim TempData02(1 To lRow, 1 To 8)  '2次元配列「TempData02」再構築
    
    For I = LBound(TempData01, 1) To UBound(TempData01, 1) '2次元縦件数をスタート1～最終行までループ
        
        
        If TempData01(I, 3) = "男" And TempData01(I, 8) < 45 Then  '抽出内条件を指定します。
                TempData02(L, 1) = TempData01(I, 1) '社員番号を格納
                TempData02(L, 2) = TempData01(I, 2) '氏名を格納
                TempData02(L, 3) = TempData01(I, 3) '性別を格納
                TempData02(L, 4) = TempData01(I, 4) '郵便番号を格納
                TempData02(L, 5) = TempData01(I, 5) '住所（都道府県）を格納
                TempData02(L, 6) = TempData01(I, 6) '住所（区市町村）を格納
                TempData02(L, 7) = TempData01(I, 7) '生年月日を格納
                TempData02(L, 8) = TempData01(I, 8) '年齢を格納
                
                L = L + 1  '2次元配列「TempData02」次の行へ+1（加算する）
        End If

    
    Next I


    ws02.Range("A2").Resize(UBound(TempData01, 1), 8) = TempData02  '2次元配列データ「TempData02」をシート「抽出リスト」へ結果を転記します。


    End Sub
    '