Excel VBA を起点とした半自動化で利用した技術

# Excel VBA を起点とした RPA
今回様々な報告書等資料を作成しなければならない事業部からの依頼で、半自動化をどこまでできるか検証を行いながら様々なコードを検討してみたので、使用したコードの一部を書き連ねてみようと思います。なお、一度に書けないので少しずつ追記することとしました。
※ 流れで記載している項目もありますが、基本的には個別の技術を順不同で記載しています。

## 自動化の起点として Excel VBA を選択
実際には PowerPoint で写真台帳を作成したり、 Word で報告書を作成したりと様々なことを実行しなくてはならないのですが、それぞれを連携させるために情報のまとめシートが存在している Excel を起点として VBA にて連携を行わせる方法を選択しました。
PowerAutomate や PowerApps 等を利用した自動化、最適化も実施していますが、 VBA での実際のコードを中心にまとめていきます。また、 VBA の基本的な記述もできるだけ書いてみようと思います。ただし詳細な説明までは行わない（そこまで深い知識を持ち合わせていない）のでコードにおける具体的な説明は公式の情報を得て頂けるとよろしいかと思います。

https://learn.microsoft.com/ja-jp/office/vba/api/overview/

## Excel VBA による半自動化
まずは Excel 上でシートを追加してまとめシートから別のシートを作る検証から。
### Sub プロシージャ
VBA の基本だと思いますが、まずは Sub プロシージャを作りましょう。
```vb
Sub Sheet_Add()

End Sub
```
### Dim で変数を宣言
VBA でのお作法はあまり理解していません。個人的には宣言等初期設定項目は最初に書くのが好きです。
```vb
Sub Sheet_Add()
    ' 初期設定
    Dim i As Integer
End Sub
```
ちなみに型を指定していない場合変数は既定で Variant だそうです。一行にまとめて指定することも可能ですが、以下の指定方法は間違いです。
```vb
Dim i , j , k As Integer
```
型はひとつずつ指定します。上記宣言だと i と j は Variant で指定されます。
```vb
Dim i As Integer, j As Integer, k As Integer
```
### 警告メッセージを停止
いろいろ組み込んでいくとこのメッセージいらないんだけどなぁとなることがあります。最初に警告メッセージを表示しないように設定することが多いです。
```vb
' 警告メッセージを停止
Application.DisplayAlerts = False
```
### 追加予定のシートがすでにあるか確認
何もしないとエラーで止まってしまいます。通常のエラー画面はできるだけユーザーに表示したくないので、事前に検証してスクリプトを止めます。
```vb
Dim SheetName As String
SheetName = "自動作成シート"
' シート名を読み込んですでに作成済みであるか確認
For i = 1 To Worksheets.Count
    If Worksheets(i).Name = SheetName Then
        MsgBox "すでに自動作成済みのシートがあります。" & vbCrLf & "再作成するにはシート名を変更するか削除してください。" & vbCrLf & "処理を中断します。"
        Exit Sub
    End If
Next
```
分かりやすくするために直前に`Dim`を置いていますが、例えば複数の`Sub`プロシージャ等で同じシート名を使いまわしたい、一か所の編集で済ませたいという場合には標準モジュールを使って記載すると良いみたいです。
```vb:標準モジュール
' 自動生成されるシート名
Public Const SheetName As String = "自動作成シート"
```
繰り返し実行したい場合にはいくつか方法があります。ここで使用していたのは`For ～ Next`で最初の数値と最後の数値を指定して最後の数値になるまで繰り返します。簡単な例としては以下です。
```vb
Dim Words, Chars, MyString 
For Words = 10 To 1 Step -1 ' Set up 10 repetitions. 
 For Chars = 0 To 9 ' Set up 10 repetitions. 
 MyString = MyString & Chars ' Append number to string. 
 Next Chars ' Increment counter 
 MyString = MyString & " " ' Append a space. 
Next Words
```
数値 0 から 9 の 10 個のインスタンスを含む文字列を作成します。各文字列は 1 つのスペースで区切られます。 外側のループは、ループを通じて毎回デクリメントされるループ カウンター変数を使用します。

https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/fornext-statement

また、今回は繰り返す数としてシートの数を数えることができる`Worksheets.Count`を利用しました。

次に条件によって動作を変更するには`If ～ Then ～ End If`を使用しています。

https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/ifthenelse-statement

今回条件としたいのは同じシート名があるかどうかなので、シート名を取得する`Worksheets(1).Name`を利用しています。通常は括弧の中にシートの番号を記載しますが、繰り返しで利用している`i`の変数を使用して動的にシートの番号を比較しています。

同じシート名があった場合には`MsgBox`で注意のメッセージを表示し`Exit Sub`で`Sub`プロシージャを終了させています。

### シートを追加
同名のシートがなければ動的にシートを追加します。
```vb
With Worksheets.Add(Before:=Worksheets(1))
    .Name = SheetName
End With
```
シートの追加は`Worksheets.Add()`を使用します。括弧の中にパラメータを記載することでシートを挿入する場所等を操作できます。今回は`Before`を利用して`Worksheets(1)`の直前にシートを追加しています。`Worksheets(1)`とは最初のシート（ 1 番目のシート）という意味になるので、ブックの最初に新規シートが追加されます。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheets.add

今回は多くの操作をまとめて実行したいので`With`を利用しました。この`With`から`End With`の間ではいろいろと省略して記載できるのでとても便利です。

https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/with-statement

なので、省略されていますが`.Name = SheetName`は追加された新しいシートの名前の指定を行っています。

### セルの高さと幅を指定
追加されたシートに内容を作っていきますが、同時にセルのデザインも整えていきます。セルの高さや幅が違うと思っていたデザインのシートになりません。
```vb
' セルの高さと幅を指定
.Range("A1").EntireColumn.ColumnWidth = 5
.Range("A1").EntireRow.rowHeight = 11.25
```
ここでは一部抜粋して提示しています。まずセルを指定するには`Range()`を使用します。いろいろな指定方法がありますが、ここでは単純に`A1`セルを直接してしている感じです。通常の Excel の記述と同じように`A2:A7`といった範囲を指定することも可能です。
このようなコマンドは階層があり、続けて記載することでいろいろな設定を変更したりすることができます。

https://learn.microsoft.com/ja-jp/office/vba/excel/concepts/cells-and-ranges/refer-to-cells-and-ranges-by-using-a1-notation

`.Range("A1").EntireColumn.ColumnWidth = 5`で`A1`セルの幅を 5 に設定しています。この数値は実際にマウスでセル幅を調整する際のカッコ内のピクセルの方ではなくその前に表示される数値の方です。同様に`.Range("A1").EntireRow.rowHeight = 11.25`で`A1`の行の高さを 11.25 に設定しています。

### セルの固定内容を追加（ヘッダー）
あらかじめ用意しておいたテンプレートシートをコピーして使用する方法もありますが、今回はすべてセルに書き込む形式で新規作成しています。ですので、ヘッダー部分等固定の項目と動的に繰り返して追記していく部分を分けて構成しています。
```vb
' セルの固定内容を追加（ヘッダー）
.Range("A1") = "自動作成シート"
.Range("A1").Font.Bold = True
```
`A1`セルはページのタイトルとしたいため、`.Range("A1").Font.Bold = True`でボールド体に変更しています。

### セルの固定内容を追加（表組）
表組部分にはヘッダー部分によくあるセルの結合等を用いた柔軟な設定を目指しました。
```vb
' セルの固定内容を追加（表組）
.Range("A3:A4").Merge
.Range("A3") = "No."
.Range("B3:D3").Merge
.Range("B3") = "項目"
.Range("B4") = "地域"
.Range("C4") = "立地環境"
.Range("D4") = "業態"
.Range("E3:E4").Merge
.Range("E3") = "備考"
.Range("A3:E4").HorizontalAlignment = xlCenter
.Range("A3:E4").Font.Size = 9
.Range("A3:E4").Interior.Color = rgbYellow
.Range("A3:E4").Borders.Weight = xlThin
```
まず`A3:A4`を`.Range("A3:A4").Merge`で縦に結合しています。結合したセルに入力する場合は一番左上のセルを選択すると良いようです。実際に結合したセルを選択状態にした時に表示されるセル番号を指定することになります。
文字列を中央寄せにするには`.HorizontalAlignment = xlCenter`で変更できます。範囲指定して一度に変更することもできますので適切に設定しましょう。同様にフォントサイズは`.Font.Size = 9`で変更、セルの塗りつぶしは`.Interior.Color = rgbYellow`で変更ができます。セルに枠線を引く場合には`.Borders.Weight = xlThin`と指定しましょう。`xlThin`は極細です。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.xlborderweight
### 別の Excel ファイルを開いて制御
ベースとなる Excel ファイルから別の Excel ファイルを開いて転記したりしたくなることがあります。その際開いた Excel ファイルと元の Excel ファイルを適切に扱う必要があります。
別の Excel ファイルを開く場合は以下のように実施します。
```vb
' コピー先 Excel ファイルを選択してファイル名を取得
With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "Excelファイル", "*.xlsx"
    .InitialFileName = ThisWorkbook.Path
    .AllowMultiSelect = False
    .Title = "編集するファイルを選択して下さい"
    If .Show = True Then
        fPath = .SelectedItems(1)
    End If
End With
If fPath = False Then
    fPath = ThisWorkbook.Path & "テンプレート.xlsx"
End If
    
Set wb = Workbooks.Open(fPath)
```
まず`Application.FileDialog`でファイルを開くためのダイアログを表示させます。`With`指定することでダイアログを開いた際の設定を短く記載できます。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.application.filedialog

次に開いたダイアログ内の設定を記述します。開くファイルを Excel ファイルのみに指定したい場合には`Filters.Add`で`"Excelファイル", "*.xlsx"`等のように指定しておけば特定のファイル、拡張子のみを表示させることができます。

今回はファイルの指定がなかった場合（ダイアログでキャンセルをクリックされた場合）に自動的にテンプレートファイルを開くように設定しています。
`If fPath = False Then`でダイアログでキャンセルをクリックしたため`fPath`の中身が空（`False`）だった場合に`fPath = ThisWorkbook.Path & "テンプレート.xlsx"`としてテンプレートファイルをパスに指定するようにしています。

キャンセルをクリックされた場合にスクリプトを抜けたい場合には`Exit Sub`と記載しておけば大丈夫です。

最後に開いた Excel ファイルを`Set wb = Workbooks.Open(fPath)`として`wb`で呼び出せるようにしておけば現在の Excel ファイルと開いた Excel ファイルをそれぞれ分けて操作ができます。

### 開いたファイルを保存する
現在の Excel をコピー元として、新たに開いた Excel ファイルに必要な項目を記載した後、該当のファイルを保存したい場合があります。特に上の項目でテンプレートファイルを編集先として開いた場合、間違ってそのまま保存してしまうとテンプレートファイルを上書きしてしまいかねません。
そこで開いたファイルの自動編集が完了した際にそのまま保存用のダイアログを表示させるには以下のように実施します。
```vb
' 名前を付けて保存
Filename = ThisWorkbook.Worksheets("シート自動作成").Range("A1")
With Application.FileDialog(msoFileDialogSaveAs)
    ' 最初に開くフォルダを現在のファイルがあるディレクトリに指定
    .InitialFileName = ThisWorkbook.Path & "\" & Filename
    
    ' 保存ファイルの種類を xlsx に設定
    .FilterIndex = 1
    
    ' ダイアログボックスを表示
    If .Show = True Then
        .Execute
    End If
End With
```
まず最初に保存用のダイアログを`Application.FileDialog`を利用して開きます。開く時の指定と違うところは開く時にはパラメーターに`msoFileDialogOpen`としていたところを`msoFileDialogSaveAs`と指定しています。
次に保存先を`InitialFileName = ThisWorkbook.Path & "\" & Filename`として現在の Excel ファイルのあるディレクトリに指定することで保存されたファイルを見失ってしまうことを回避しています。また、間違ってテンプレートを上書きしてしまわないように事前に`Filename = ThisWorkbook.Worksheets("シート自動作成").Range("A1")`としてワークシート上のセルの情報からファイル名を自動生成しています。

## 全国物価統計調査のデータを利用したデータの取得（流れ）
今回はもとのデータとなるシートに全国物価統計調査のアイスクリームのデータを使用して試してみます。これらのデータから地域、立地環境等のデータを自動化シートにチェックボックスで配置して必要なデータを選択して取得できるようにして見たいと思います。

### 配列にベースとなるデータをまとめる
表組に動的にデータを記載していく前に、事前に配列に必要なデータをまとめています。このようにしておくことで表組を作る際のループが簡易にできたりデータの使いまわしもできるようになります。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12937/f1809e5b-fa9b-13fd-ff98-8cc2bde435b3.png)
「開発」タブの「挿入」からフォームコントロールでチェックボックスを挿入し、右クリックでコントロールの書式設定を選択して開きます。「コントロール」タブのリンクするセルをチェックボックスを配置した真下に設定すれば「TRUE/FALSE」の表記を裏に隠して利用できます。チェックボックスの背景は白で塗りつぶしてしまいましょう。

今回利用するデータに伴い「秋田」から「山梨」までのチェックボックスを用意しました。まずはこのチェックボックスのどれがオンになっているかデータの取得から開始します。

### Sub プロシージャを Call ステートメントで呼び出す
他の Sub プロシージャから配列を作成する Sub プロシージャを Call ステートメントで呼び出して利用する方法を検討します。まずは配列を作成する Sub プロシージャを作っていきます。

```vb
Sub Create_main_data(ByRef data As Variant, ByRef list As Integer)
    ' 初期設定
    Dim region(14) As Variant
    Dim Count As Integer
    Dim i As Integer
End Sub
```
配列用に変数を用意する方法はいくつかありますが、今回は配列のサイズを固定で用意してみます。チェックボックスの数が動的に変動したりはしないのでこれで特に問題はありません。用意しているチェックボックスは 15 個ですので、配列は`region(14)`として用意しました。これは何も指定しないと 0 から開始されるため 14 とすることで 15 個の箱を用意したという事になります。

呼び出し側では以下のように指定しています。今回は参照渡し（`ByRef`）を利用して配列の受け渡しを行っています。
```vb
Dim list As Integer
Dim data As Variant
' チェック内容を読み込み項目の配列を作成
Call Create_main_data(data, list)
```

### チェックボックスの内容を配列に代入

自動化シートに用意したチェックボックスの内容を読み込んで配列に代入していきます。
```vb
' チェック内容を読み込み項目の配列を作成
Count = 1
For i = 2 To 16
    If Worksheets("自動化シート").Cells(i, 2) = True Then
        region(Count) = Worksheets("自動化シート").Cells(i, 3).Value
        Count = Count + 1
    End If
Next i
```
今回はチェックボックスを配置しているシート名が「自動化シート」、チェックボックスのリンクセルは`B2`から`B16`に配置されています。またその横の`C2`から`C16`にチェックボックスに該当する都道府県名を入力していますので、配列のチェックでは`For ～ Next`を利用し`Cells(i, 2)`の内容が`True`であるセルを調べて、配列には`Cells(i, 3).Value`で都道府県名を入力しています。

変数`Count`でチェックボックスの`True`の件数を残しているのは、後のループで利用するためです。

## データシートから内容を取得して配列に追加
チェックボックスにチェックの付いた都道府県の情報を取得して配列に代入していきます。今回使用しているリストは都道府県名の下のセルは空白になっており、どこからどこまでが該当のデータであるのか判定を行う必要があります。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12937/38991c6d-5086-7b3c-5adb-364150bad0dd.png)
例えば上記リストの「東京都」の右側 2 つのセルは空白です。数値としては`I1462`にある「総数」のセルから`I1624`にある「その他」の末端`J1641`にある「その他」までを取得したいのですが、それぞれに空白セルがあるため「東京都」の末端を推測しずらいです。

そこでいくつかの手法を組み合わせて取得したい末端セルを確認してみたいと思います。
### チェック内容を読み込み項目の配列を作成
まずチェックボックスは簡単に以下のようになっています。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/12937/a9b231e0-cc28-43ab-747b-7b83a85767fd.png)
チェックボックスのチェックの付いている都道府県の情報だけ取得します。
```vb
Dim Areas() As Variant
Dim Count As Integer
' チェック内容を読み込み項目の配列を作成
Count = 0
For i = 2 To 16
    If Worksheets("自動化シート").Cells(i, 2) = True Then
        Areas(Count) = Worksheets("自動化シート").Cells(i, 3).Value
        Count = Count + 1
    End If
Next i
```
チェックボックスの下にある B 列にチェックボックスと連動したセルが指定されていますので、 B 列を 2 行目から 16 行目まで繰り返して`True`の項目だけ配列`Areas`に代入しています。

実際にはまとめのシート等には複数のデータが記載されていて、そのうち何らかの処理を行うには一部のデータのみがあれば良い場合が多いです。今回使用しているデータも項目数が多いので、このうち「集計価格数」と「平均」の項目のみを取得して配列に代入してみようと思います。
### With ステートメント

```vb
' 第3表シートからデータを取得して配列に追加
With Worksheets("第3表 (11)")

End With
```
特定のシートの情報を取得する場合、`ブック名.ワークシート名.Range()`のような処理が必要となりますが VBA 上では省略して記述できることもあります。ブック名、ワークシート名を省略した場合には現在アクティブなブック、シートが使用されてしまうため、複数のブックを開いて処理するような場合や、ワークシートが複数存在しているような場合には適切に指定してあげる方が安全です。
今回はブックはひとつだけですので省略していますが、ワークシートは複数存在しかつ切り替えて使用することが考えられるため適切に指定して実行します。その際毎回`ワークシート名.Range()`と記載しているとコードが長くなってしまうため`with ～ End With`を利用してこの記載の間ではコードを短く指定できるように工夫してみます。

https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/with-statement

### ワークシートの行数を取得
Excel の処理を行っていると操作したいセルのある行数やデータの存在している最後の行数等を取得したくなることが多くあります。
例えば今回の処理したいシートの最終行を取得するために以下のような方法を取っています。
```vb
' ワークシートの最終行を取得
reg = .Cells.SpecialCells(xlCellTypeLastCell).Row
```

https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.specialcells

`SpecialCells`メソッドを使用して型に`xlCellTypeLastCell`「使われたセル範囲内の最後のセル」を指定することでワークシートの最終行`.Row`を数値で取得しています。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.xlcelltype

同様に今回は指定範囲（都道府県のデータがある範囲）の最初の行と最後の行を取得するために以下のようなコードを記述しました。

```vb
' チェックシートの都道府県のデータのみ取得
ReDim AllData(Count)
Count = 1
For Each Area In Areas
    For i = 13 To reg
        If Area = .Cells(i, 8).Value Then
            RowTop = .Cells(i, 8).Row
        End If
    Next i
    For i = RowTop To reg
        If .Cells(i, 8).Value <> "" And .Cells(i, 8).Value <> .Cells(RowTop, 8).Value Then
            GoTo Continue
        End If
        For Each region In Location
            If .Cells(i, 9) = region Then
                RowMax = .Cells(i, 9).Offset(1, 1).End(xlDown).Row
            End If
        Next
    Next i
Continue:
    Set AllData(Count) = .Range(.Cells(RowTop, 8), .Cells(RowMax, 14))
    Count = Count + 1
Next
```

まず全体から都道府県の必要なデータのみ対象とするため`Areas`配列内に含まれている都道府県をひとつずつ取り出して処理しています。
```vb
For Each Area In Areas

Next
```
次に先ほど取得したワークシートの最終行を利用してデータのある最初の行から最終行までをループさせています。
```vb
For i = 13 To reg

Next i
```
この中で取り出した都道府県名`Area`と都道府県名が記載されたセル`.Cells(i, 8).Value`を比較して、一致した行を最初の行`RowTop`として取得しています。
```vb
If Area = .Cells(i, 8).Value Then
    RowTop = .Cells(i, 8).Row
End If
```
さらに取得した都道府県の最初の行を基準として該当の都道府県のデータがある最終行を取得する処理をループで処理しています。
```vb
For i = RowTop To reg

Next i
Continue:
```
ここでループの外に`Continue:`という飛び先を用意しておき、必要なループ処理が終わった際に無駄なループをさせずにループを終了させてしまう手法を取っています。そのための飛び先が`Continue:`です。
このデータシートの場合、都道府県のデータが入っている列には都道府県名以外入っていません。他の行では空欄になっていることを利用し、空欄ではなく現在処理している都道府県名と違う都道府県名が現れた場合にそれ以降の処理は行わないという処理を行っています。
```vb
If .Cells(i, 8).Value <> "" And .Cells(i, 8).Value <> .Cells(RowTop, 8).Value Then
    GoTo Continue
End If
```
次にデータ内で「立地環境」としている物を事前に配列に用意しておき、ループでひとつずつ取り出して処理しています。
```vb
Dim Location As Variant, region As Variant
Location = Array("総数", "駅周辺商店街", "駅周辺商店街以外", "住宅地周辺商店街", "住宅地周辺商店街以外", "幹線道路周辺商店街", "幹線道路周辺ショッピングセンター", "幹線道路周辺その他", "地下街", "その他")
For Each region In Location

Next
```
現在のセルの位置の「立地環境」データ`.Cells(i, 9)`と配列から取り出した「立地環境」データ`region`を比較しその横に並んでいる「業態」部分の最後の行を割り出して最終行の変数`RowMax`に代入しています。
```vb
If .Cells(i, 9) = region Then
    RowMax = .Cells(i, 9).Offset(1, 1).End(xlDown).Row
End If
```
`Offset()`プロパティは現在のセルから指定方向に移動したセルの位置を取得します。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.offset

`End()`プロパティは選択された範囲の最後のセルを取得します。今回は`xlDown`で上から下に調べて最後のセル（空白の目前のセル）を取得しています。
セル範囲が明確に分かっており、途中に空白セルも存在する最後のセルを取得したい場合等には`xlUp`で下端から調べるという方法もあります。

https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.end

https://learn.microsoft.com/ja-jp/office/vba/api/excel.xldirection

これらの組み合わせと`.Row`にて最後の行を取得しています。

最後に先頭行から最終行までのデータをまとめて`Range`として取得しています。
```vb
Set AllData(Count) = .Range(.Cells(RowTop, 8), .Cells(RowMax, 14))
```

### `Range`から必要部分のみ配列抽出

ここまでで取得した`Range`データは H 列から N 列までのすべての範囲内のデータです。ここから後で使いやすくするために必要なデータのみ抜き出して配列を作成したいと思います。

まずは配列に必要な範囲の箱を用意します。
```vb
ReDim data((RowMax - RowTop - 10) * (Count - 1), 4)
```
今回は都道府県ごとに決まった行数（ 180 行）になっているため、最終行から最初の行を引いた数値を使用して配列の大きさを決定しています。チェックボックスに 2 か所以上の都道府県が選ばれていることを考えて都道府県の数で掛けています。「地域」と「立地環境」には数値がないため 10 を引いて箱の数を微調整しています。
本当はできるだけ動的に取得した方が汎用的な用途には良いので、複数の都道府県がある場合それぞれの`RowMax`と`RowTop`の数値を使用して取得する方が正確になるとは思います。

まずは都道府県の数を保持している`Count`変数を利用して都道府県の数分だけループを実行します。
```vb
For i = 1 To Count - 1

Next i
```
さらに先ほど`Range`として取得したデータをループにて取得していきます。
```vb
For Each singleData In AllData(i)

Next singleData
```
現在`Range`データは`AllData()`配列に二次元配列として保存されているため、都道府県ごとに取り出す必要がありますのでループでひとつずつ処理を行っています。

その中で分岐で必要な情報を抜き出し、関数の戻り値である配列`data()`に値をセットしていきます。今回は H,I,J,M,N 列のデータだけ取得したいので、上記ループで取得した`Range`データから`Address`で範囲の文字列を取り出して列の情報だけを変数に取得しておきます。
```vb
Addr = Split(singleData.Address, "$")(1)
```
`Address`で取得できるのは`$H$1680`といったセルの絶対アドレスですので`Split()`関数で`$`で分割した最初の 1 つ目を現在の列として取得しています。

https://learn.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/split-function

取得した列の情報を元に分岐で配列に代入していきます。
```vb
If singleData.Value = "" Then
ElseIf Addr = "H" Then
    Area = singleData.Value
ElseIf Addr = "I" Then
    Location = singleData.Value
ElseIf Addr = "J" Then
    outlet = singleData.Value
    data(j, 0) = Area
    data(j, 1) = Location
    data(j, 2) = outlet
ElseIf Addr = "M" Then
    data(j, 3) = singleData.Value
ElseIf Addr = "N" Then
    data(j, 4) = singleData.Value
    j = j + 1
End If
```
最初の条件`If singleData.Value = "" Then`で空のセルだった場合には何も処理しないようにしていますが、以降は必要な列だった場合に配列`data()`に値を代入しています。最後の N 列の判定で変数`j`のカウンタをプラスして`data()`配列を作っていきます。

全体的には以下のように構成しました。
```vb
ReDim data((RowMax - RowTop - 10) * (Count - 1), 4)
j = 0
For i = 1 To Count - 1
    For Each singleData In AllData(i)
        Addr = Split(singleData.Address, "$")(1)
        If singleData.Value = "" Then
        ElseIf Addr = "H" Then
            Area = singleData.Value
        ElseIf Addr = "I" Then
            Location = singleData.Value
        ElseIf Addr = "J" Then
            outlet = singleData.Value
            data(j, 0) = Area
            data(j, 1) = Location
            data(j, 2) = outlet
        ElseIf Addr = "M" Then
            data(j, 3) = singleData.Value
        ElseIf Addr = "N" Then
            data(j, 4) = singleData.Value
            j = j + 1
        End If
    Next singleData
Next i
```

追記中…


## PowerPoint による半自動化
追記中…