第3回 直感！スグに使える業務向けVBA汎用プロシージャ(セル⇔配列)

第0回で配布しました汎用プロシージャのコードの紹介と簡単な解説をやっていきたいと思います！
以下のリンクから .bas ファイルをダウンロードできます（zipファイル）

https://drive.google.com/file/d/11qEUTsq87UItzoKu2okX5WgEopRercCb/view?usp=drive_link

今回ご紹介するプロシージャは
| プロシージャ名		| 概要						|
|-------------------------------|-----------------------------------------------|
| CellToArray | 指定したセル範囲のデータを配列に格納(インデックスは1開始)		|
| PasteArray  | 起点を指定し配列の内容をペースト(インデックスは1開始)		|

の2つになります！この2つは言ってしまえばコピー(=CellToArray)&ペースト(=PasteArray)なのですが、シンプル故に活躍の幅が広いということは想像に難くないと思います。

VBAの標準の機能に**Copyメソッド**というものと**PasteSpecialメソッド**があり同様にコピー&ペーストを自動化することができるのですが、これらとの差別化点として先ず動作速度が挙げられます。

少量のデータであればあまり気になりませんが、大量のデータを処理したい際に配列を使うか使わなかでその速度は大きく変わります。詳細な動作速度の違いは他のサイト様で検証・解説されているところがありますのでここでは割愛させていただきます...

では、コードの紹介に移ります！

## CellToArray
~~~
Function CellToArray(startRow As Long, startCol As Long, endRow As Long, endCol As Long, Optional targetSheet As Worksheet) As Variant
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜セル範囲の内容を2次元配列として抽出
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜startRow - 開始行番号(Long型)
'　引数２　｜startCol - 開始列番号(Long型)
'　引数３　｜endRow - 終了行番号(Long型)
'　引数４　｜endCol - 終了列番号(Long型)
'　引数５　｜targetSheet - 対象のワークシートオブジェクト(規定値:ActiveSheet)(Worksheet型)
'------------------------------------------------------------------------------------------------------------------------------
'　戻り値　｜Variant型 - 指定範囲セルの内容を抽出した2次元配列(インデックスは1開始)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim vLoop       As Long '行ループカウンタ
    Dim hLoop       As Long '列ループカウンタ
    Dim customArr   As Variant '格納用配列
    
    If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
    
    'ユーザー定義エラー
    If startRow < 1 Or endRow < 1 Or startCol < 1 Or endCol < 1 Then
        Err.Raise vbObjectError + 1001, "ArrayInput", "引数は1以上の整数にしてください"
    End If
    If startRow > endRow Or startCol > endCol Then
        Err.Raise vbObjectError + 1002, "ArrayInput", "開始の数値は終了よりも小さいものにしてください"
    End If
    
    '配列の初期化
    ReDim customArr(endRow - startRow + 1, endCol - startCol + 1)
    
    'セル内容の抽出
    For vLoop = 1 To endRow - startRow + 1
        For hLoop = 1 To endCol - startCol + 1
            customArr(vLoop, hLoop) = targetSheet.Cells(vLoop + startRow - 1, hLoop + startCol - 1)
        Next hLoop
    Next vLoop
    
    CellToArray = customArr
    
End Function
~~~

コピーしたい範囲を第1引数～第4引数にて整数で指定し、その範囲の中身が配列に格納されるというプロシージャになります。例えばアクティブシートのA1セルからE5セルのデータを格納したい場合は

~~~
配列名 = CellToArray(1,1,5,5)
~~~

となります。"A1:E5"といった表記にしなかったのは列数の多い範囲をコピーしたい場合数値のほうが**直感的**に指定できると考えたからです。基本私は範囲を指定する際は数値で指定するスタイルをとっています。第1回で紹介しました**GetRowEnd / GetColEnd**とも相性がいいですね！

また、出力の配列は必ず2次元配列となります。配列のインデックスは1開始となるのですが、0(=空のインデックス)も存在するためです。VBAにおける配列は0からスタートなのですが、ユーザー的にはやはり1からのほうが考えやすいと思いますので1開始にしました。ケースバイケースになりますが、インデックス0を活かして何かしらの演算をするという使い方もアリですね！

![Excel-3-1.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/4046902/0d6bc7ab-218b-4aba-8949-a1a623f6c5c1.png)

例えば先ほどのようにA1セルからE5セルのデータを格納するとその出力の配列の中身は以下のようになります(イメージ図)

![Excel-3-2.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/4046902/51792b76-922c-4583-9ddf-d81b2c6319af.png)

## PasteArray
~~~
Sub PasteArray(originalArray As Variant, startRow As Long, startCol As Long, pasteDirection As Long, Optional targetSheet As Worksheet)
'------------------------------------------------------------------------------------------------------------------------------
'　概要　　｜配列の内容を任意シートの任意のセルを起点に貼り付ける(インデックスは1開始)
'------------------------------------------------------------------------------------------------------------------------------
'　引数１　｜originalArray - 貼り付けたい配列(Worksheet型)
'　引数２　｜startRow - 開始行番号(Long型)
'　引数３　｜startCol - 開始列番号(Long型)
'　引数４　｜pasteDirection - 貼り付け方向(1:縦方向,2:横方向)(Long型)
'　引数５　｜targetSheet - 対象のワークシートオブジェクト(規定値:ActiveSheet)(Worksheet型)
'------------------------------------------------------------------------------------------------------------------------------
'　実装　　｜Ver.1.0.0(2025/04/20:新規)
'------------------------------------------------------------------------------------------------------------------------------
    
    Dim vLoop       As Long '行ループカウンタ
    Dim hLoop       As Long '列ループカウンタ
    Dim vNum        As Long '行番号
    Dim hNum        As Long '列番号
    Dim dimCount    As Long '配列次元数
    
    If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
    
    'ユーザー定義エラー
    If startRow < 1 Or startCol < 1 Then
        Err.Raise vbObjectError + 1001, "ArrayPaste", "引数は1以上の整数にしてください"
    End If
    If pasteDirection <> 1 And pasteDirection <> 2 Then
        Err.Raise vbObjectError + 1002, "ArrayPaste", "引数は1(縦方向)または2(横方向)にしてください"
    End If
    If IsArray(originalArray) <> True Then
        Err.Raise vbObjectError + 1003, "ArrayPaste", "第一引数は配列を指定してください"
    End If
    
    '変数の初期化
    vNum = startRow
    hNum = startCol
    
    '配列の次元数の確認
    On Error GoTo dimConfirm1
    If UBound(originalArray, 2) > 0 Then
        dimCount = 2
        GoTo dimConfirm2
    End If
dimConfirm1:
    dimCount = 1
dimConfirm2:
    
    '配列内容の貼り付け
    If pasteDirection = 1 Then
        If dimCount = 1 Then
            For vLoop = 1 To UBound(originalArray)
                targetSheet.Cells(vNum, hNum) = originalArray(vLoop)
                vNum = vNum + 1
            Next vLoop
        ElseIf dimCount = 2 Then
            For vLoop = 1 To UBound(originalArray, 1)
                For hLoop = 1 To UBound(originalArray, 2)
                    targetSheet.Cells(vNum, hNum) = originalArray(vLoop, hLoop)
                    hNum = hNum + 1
                Next hLoop
                vNum = vNum + 1
                hNum = startCol
            Next vLoop
        End If
    ElseIf pasteDirection = 2 Then
        If dimCount = 1 Then
            For hLoop = 1 To UBound(originalArray)
                targetSheet.Cells(vNum, hNum) = originalArray(hLoop)
                hNum = hNum + 1
            Next hLoop
        ElseIf dimCount = 2 Then
            For vLoop = 1 To UBound(originalArray, 2)
                For hLoop = 1 To UBound(originalArray, 1)
                    targetSheet.Cells(vNum, hNum) = originalArray(hLoop, vLoop)
                    hNum = hNum + 1
                Next hLoop
                vNum = vNum + 1
                hNum = startCol
            Next vLoop
        End If
    End If
    
End Sub
~~~

これは個人的にかなり力を入れたプロシージャになります！第1引数にペーストしたい配列を入れ、貼り付けの起点のセルを第2、第3引数に数値で指定し、第4引数で貼り付けの方向も指定できてしまうというプロシージャになっております。

ちょっとマニアックなのですが、第1引数の配列の次元チェック機能が内包されており、第5引数で貼り付けたいシートも自由に選択できますので汎用性の鬼になっております(笑)

配列の次元チェックは以下のセクションで行われます。
~~~
    '配列の次元数の確認
    On Error GoTo dimConfirm1
    If UBound(originalArray, 2) > 0 Then
        dimCount = 2
        GoTo dimConfirm2
    End If
dimConfirm1:
    dimCount = 1
dimConfirm2:
~~~

1次元配列に対してUbound関数の第2引数を指定するとエラーが出力されるのですが、そこを逆手に取り、エラーが発生した際は1次元配列、エラーが発生しなければエラーが発生しなければ2次元配列だと判断します。

そして、CelltoArrayと組み合わせるとこのような使い方ができます。Sheet1のA1セルからE5セルまでをコピーし、Sheet2のB2セルを起点に配列を横方向に貼り付けてみましょう。

~~~
Sub Main()
    
    Dim A As Variant
    
    A = CellToArray(1, 1, 5, 5, Sheet1)
    Call PasteArray(A, 2, 2, 2, Sheet2)
    
End Sub
~~~

コピー元

![Excel-3-3.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/4046902/09e73059-f8ce-4030-92de-29b1046dffb3.png)

に対して

![Excel-3-4.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/4046902/8c33dabc-19b6-4a20-a466-6339015c96a1.png)

のようになります。PasteArrayの第4引数を1にすれば配列の内容をそのままB2セルを起点に貼り付けできます。恐らくこのような運用がメジャーになるかと思います。

使える場面はとにかくたくさんありますので、爆速コピペの威力を体感してみてください！

## 直感！VBAシリーズ記事一覧
もしよろしければ他の記事もご覧ください！

https://qiita.com/Reko/items/3e482f9a73353e964f00

https://qiita.com/Reko/items/af042ae33cdc01e1dc96

https://qiita.com/Reko/items/9e211c9c496e12283f33

https://qiita.com/Reko/items/b5abcdf614cef5d4073a

https://qiita.com/Reko/items/3451339e723a34ac7897

https://qiita.com/Reko/items/40c66556ac51a8006ea6

https://qiita.com/Reko/items/0269b2bece07a675e797

https://qiita.com/Reko/items/e2d0d0bf2dea4feface1

https://qiita.com/Reko/items/b995c3da88d25f6e0104

https://qiita.com/Reko/items/bc97d79599cfd431b2f3

https://qiita.com/Reko/items/1731aaddfc6e50c209df

https://qiita.com/Reko/items/554a47f2aa944e2eec5e

https://qiita.com/Reko/items/e8253ac68ccafba44ad3