左上セルを指定してテーブルを配列にして返す関数

セル範囲を決め打ちして固定範囲のテーブルを読み込む

Excelのワークシートにあるテーブルを2次元配列に格納したいことは、VBAでプログラミングしていてよくあると思います。

次のようにテーブルのセル範囲が固定されている場合、

テーブルのセル範囲B3:D7（ワークシート1Sheet1）を決め打ちしてRangeオブジェクトで配列が読み込めます。

コードと出力結果は次のようになります。

標準モジュール

Sub GetArrayByRange()

  Dim Table As Variant
    
  Table = Sheet1.Range("B3:D7")

  ' 1行目
  Debug.Print Table(1, 1); Table(1, 2); Table(1, 3)
  ' 2行目
  Debug.Print Table(2, 1); Table(2, 2); Table(2, 3)

End Sub

左上セルを指定して可変範囲のテーブルを読み込む

セル範囲が固定しているなら上記のようにすればいいのですが、テーブルの行数がデータの追加ごとに増えるとか、行数・列数がプログラムにとって未定のテーブルを読み込みたいときは、テーブルのセル範囲を調べる必要があります。

今、空っぽのB2、1行1列のB6、3行1列のB10:B12、3行3列のB16:D18の4つのテーブルをワークシート1Sheet1に用意しました。

これらのテーブルのような次元（行数、列数）が違うテーブルを、それぞれのテーブルの左上のセルだけを指定して読み込みたいと思います。

標準モジュール

' セルPointCellと同列の最終行のセルを返す
Function GetEndRow(ByRef PointCell As Range) As Range

  If PointCell.Offset(1, 0).Value = "" Then
    ' 1行下のセルが空ならPointCellを返す
    Set GetEndRow = PointCell
  Else
    Set GetEndRow = PointCell.End(xlDown)
  End If

End Function


' セルPointCellと同行の最終列のセルを返す
Function GetEndColumn(ByRef PointCell As Range) As Range

  If PointCell.Offset(0, 1).Value = "" Then
    ' 1列右のセルが空ならPointCellを返す
    Set GetEndColumn = PointCell
  Else
    Set GetEndColumn = PointCell.End(xlToRight)
  End If

End Function


' ワークシートの表の左上のセルLeftTopを引数に表を2次元配列にして返す
Function GetTableAs2dArray(ByRef LeftTop As Range) As Variant

  Dim RightBottom            As Range
  Dim Scalar(1 To 1, 1 To 1) As Variant

  ' 表の右下のセルを求める
  Set RightBottom = LeftTop.Worksheet.Cells(GetEndRow(LeftTop).Row, GetEndColumn(LeftTop).Column)
  ' 表を2次元配列として返す
  If LeftTop.Address = RightBottom.Address Then
    ' Range()は1セルだと配列を返さないので2次元配列Scalarを経由させる
    Scalar(1, 1) = LeftTop.Value
    GetTableAs2dArray = Scalar
  Else
    GetTableAs2dArray = Range(LeftTop, RightBottom)
  End If

End Function

引数のセルから使用されている最終行のセルを返すGetEndRow関数、引数のセルから使用されている最終列のセルを返すGetEndColumn関数、これら2つの関数を使ってセル範囲を特定してテーブルを配列として返すGetTableAs2dArray関数の3つを作りました。

空っぽのテーブル

GetTableAs2dArray関数を使ってみます。

まず、空っぽのテーブル（左上セルB2）です。

標準モジュール

Sub EmptyTable()

  Dim Table As Variant
    
  Table = GetTableAs2dArray(Sheet1.Range("B2"))

End Sub

GetTableAs2dArray関数の戻り値Table変数は2次元配列で、値はTable(1,1) = Emptyとなっています。

1行1列のテーブル

次に、1行1列のテーブル（左上のセルB6）を読み込みます。

標準モジュール

Sub Table1x1()

  Dim Table As Variant
    
  Table = GetTableAs2dArray(Sheet1.Range("B6"))
  Debug.Print Table(1, 1)

End Sub

戻り値Table変数はさっきと同様に2次元配列で、値はTable(1,1) = 11となっています。

3行1列のテーブル

3行1列のテーブル（左上のセルB10、セル範囲B10:B12）を読み込みます。

標準モジュール

Sub Table3x1()

  Dim Table As Variant

  Table = GetTableAs2dArray(Sheet1.Range("B10"))
  Debug.Print Table(1, 1)
  Debug.Print Table(2, 1)
  Debug.Print Table(3, 1)

End Sub

戻り値TableはTable(1,1) = 11、Table(2,1) = 21、Table(3,1) = 31の2次元配列です。

3行3列のテーブル

3行3列のテーブル（左上のセルB16、セル範囲B16:D18）を読み込みます。

標準モジュール

Sub Table3x3()

  Dim Table As Variant
  Dim RowIndex As Long
  Dim ColumnIndex As Long
  
  Table = GetTableAs2dArray(Sheet1.Range("B16"))
  
  For RowIndex = LBound(Table, 1) To UBound(Table, 1)
    For ColumnIndex = LBound(Table, 2) To UBound(Table, 2)
      Debug.Print "(" & RowIndex & "," & ColumnIndex & ") ="; Table(RowIndex, ColumnIndex)
    Next
  Next

End Sub

戻り値Tableは

• 1行目 Table(1,1) = 11、Table(1,2) = 12、Table(1,3) = 13
• 2行目 Table(2,1) = 21、Table(2,2) = 22、Table(2,3) = 23
• 3行目 Table(3,1) = 31、Table(3,2) = 32、Table(3,3) = 33

の2次元配列です。

関数のポイント

こんな感じで、任意のm行n列のテーブルを2次元配列で返すGetTableAs2dArray関数を作って、使い方のサンプルを載せました。

この関数は、引数のセルが空でも、1行1列（1つの値）でも、2行以上2列以上のテーブルとなっていても、2次元配列Table(i, j)を返します。

戻り値の変数の次元が決まっているので、戻り値Tableを使うときはいつでもLboundとUboundを使ったForループでOKです。（LboundやUboundは配列でないとエラーを出します）

標準モジュール

For RowIndex = LBound(Table, 1) To UBound(Table, 1)
  For ColumnIndex = LBound(Table, 2) To UBound(Table, 2)
    Table(RowIndex, ColumnIndex)
  Next
Next

ちょっと応用

ワークシート内のセルを検索してDictionaryオブジェクトに蓄積する関数 - Qiitaと組み合わせると、次のようなワークシートの複数のテーブルを一括処理できます。

各テーブルの近くに（上記の例ではテーブルの左上セルの1つ上）目印となる文字列を入力しておきます。

次のように目印のセルを全て検索して、蓄積し、ループで1つずつテーブルを処理します。

標準モジュール

Sub MultiTable()

  Dim FoundCellSet As Dictionary
  Dim CellAddress  As Variant
  Dim Table        As Variant

  ' 引数1のワークシート内の引数2と完全一致するセルを全て探してFoundCellSetに代入する
  Set FoundCellSet = FindCells(Sheet1, "[Table]")

  ' 見つかったセルからテーブルを2次元配列で読み込み処理する
  For Each CellAddress In FoundCellSet
    ' テーブルをセットする
    Table = GetTableAs2dArray(FoundCellSet(CellAddress).Offset(1, 0))
    ' テーブルに何らかの処理をする
  Next

  Set FoundCellSet = Nothing

End Sub

複数のテーブルで同じ処理がしたい、テーブルはそれぞれ行数・列数が異なるという場合にかなり有効だと思います。例えば、私は、ワークシート上のテーブルを一気にSQLiteデータベースに追加したいというときにこのルーチンを使っています。