Excel VBAで表を取得するテクニック

基本的な表の最終行と最終列の取得方法

ループで探索する

前章の表を扱う上で、まず使えそうなのは単純にVBAでループを使って探索する方法は以下です。

 Dim i, j As Integer
    
 i = 3
 j = 2
 While Cells(i, j) <> ""
     i = i + 1
 Wend
    
 MsgBox "最終行は" & i

単純にデータが上の行からどこまで入っているかを行で追うものとなっています。ロジックに悩んだらまず使えそうですね。

VBAのプロパティで最終セルを取得する

前述の方法だと表が二つになった場合、前述のループでは最終セルは取れないので次はVBAのプロパティをとってみましょう。

具体的には以下のコードになります。ただ表ごとの最終セルは取れていないことに注意ください（あくまでVBAの機能としてです）。

 Dim rowLast, colLast As Integer

 rowLast = Cells.SpecialCells(xlCellTypeLastCell).row
 colLast = Cells.SpecialCells(xlCellTypeLastCell).Column
    
 MsgBox "最終行は" & rowLast & vbCrLf & _
        "最終列は" & colLast

SpecialCells(xlCellTypeLastCell)の最終行の判定ですが、以下のように罫線が引かれた場合は、罫線込みで判定します。以下の例ですと「最終行は11　最終列は4」です。

実際のケースを想定した取得方法

上記で基礎的なことは分かったとして、実際に１つのシートに表が複数ある場合はどう扱うかを本章で述べます。例えば以下のようにシートに２つの表があった場合を想定します。

どうやって表を特定するのか、以降でまとめています。

ループを駆使して、文字検索からの表の範囲を出してみる

真っ先に思いついたのはやはりループで探索することですね。２つも表があると、各表の境界線を活用する必要があり、以下の手順で書いてみました。

①　シートの最終セル番地を取得する

②　①で取得した最終セルまでの範囲で「表１」「表２」の文字列をループで探す
　　（見つからないならそのまま終了）

③　表の名前が見つかったらオフセットで一つ下にずらす（表題の下に表があるという体）

④　表の罫線の終わりまで探索する

⑤　罫線の終わりのセル番地を取得する

Sub 集計_Click()
    Dim rowLast, colLast As Integer
    Dim tableLastCell As range

    rowLast = Cells.SpecialCells(xlCellTypeLastCell).row
    colLast = Cells.SpecialCells(xlCellTypeLastCell).Column
    
    MsgBox "最終行は" & rowLast & vbCrLf & _
        "最終列は" & colLast

    Set tableLastCell = getTableLastCell(ActiveSheet, "表1", rowLast, colLast, 1, 0)
    MsgBox tableLastCell.row
    Set tableLastCell = getTableLastCell(ActiveSheet, "表2", rowLast, colLast, 1, 0)
    MsgBox tableLastCell.row
End Sub

'表の最後のセル番地を取得
Function getTableLastCell(ByRef ws As Variant, ByVal tableName As String, _
                        ByVal rowCount As Integer, ByVal colCount As Integer, _
                        ByVal offsetRow As Integer, ByVal offsetCol) As range
    Dim i, j As Integer
    Dim rowStart, colStart As Integer
    Dim rowLast, colLast As Integer
    
    For i = 1 To rowCount
        For j = 1 To colCount
            If ws.Cells(i, j).Value = tableName Then
                rowStart = i + offsetRow
                colStart = j + offsetCol
                GoTo BreakLabel
            End If
        Next
    Next
BreakLabel:
    i = rowStart
    j = colStart
    '表の最後のセルの行番号を取得する
    While ws.Cells(i, colStart).Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone
        rowLast = i
        i = i + 1
    Wend

    '表の最後のセルの列番号を取得する
    While ws.Cells(rowStart, j).Borders(xlEdgeBottom).LineStyle <> xlLineStyleNone
        colLast = j
        j = j + 1
    Wend
    Set getTableLastCell = ws.Cells(rowLast, colLast)
End Function

ただし、これでは文字探索のループが非常に効率悪いので、まだ工夫の余地があります。

VBAの標準関数・プロパティ（Find、CurrentRegion）を使ってみる

前述ではループを使って文字探索してましたが、さすがにVBAの機能として文字探索とかはあるだろうと思い、VBAの標準関数やプロパティを使ってみました。

まず使ったのがFind関数で、これは文字列探索で使えます。次にCurrentRegionですが、これは指定したセル番地から表になっている範囲を取得します。

CurrentRegionでは罫線のみの行は取得しないです。

その試行錯誤の結果、以下の結果となりました。

Sub 集計_Click()
    Dim rowLast, colLast As Integer
    Dim tableRange As range

    rowLast = Cells.SpecialCells(xlCellTypeLastCell).row
    colLast = Cells.SpecialCells(xlCellTypeLastCell).Column

    Set tableRange = getTableRange(ActiveSheet, "表1", rowLast, colLast, 1, 0)
    MsgBox "最初のセル番地は、行：" & tableRange.row & "、列：" & tableRange.Column & vbCrLf _
            & "最後のセル番地は、行：" & tableRange.Rows(tableRange.Rows.Count).row _
            & "、列：" & tableRange.Columns(tableRange.Columns.Count).Column
    Set tableRange = getTableRange(ActiveSheet, "表2", rowLast, colLast, 1, 0)
    MsgBox "最初のセル番地は、行：" & tableRange.row & "、列：" & tableRange.Column & vbCrLf _
            & "最後のセル番地は、行：" & tableRange.Rows(tableRange.Rows.Count).row _
            & "、列：" & tableRange.Columns(tableRange.Columns.Count).Column
End Sub

'表の範囲を取得
Function getTableRange(ByRef ws As Variant, ByVal tableName As String, _
                        ByVal rowCount As Integer, ByVal colCount As Integer, _
                        ByVal offsetRow As Integer, ByVal offsetCol) As range
    Dim rowStart, colStart As Integer
    Dim rowLast, colLast As Integer
    Dim myRange As range
    
    '文字列探索
    Set myRange = ws.range(Cells(1, 1), Cells(rowCount, colCount)).Find(tableName, LookAt:=xlPart)
    If myRange Is Nothing Then
        Set myRange = Nothing
    Else
        '表の最初のセル番地を取得する
        rowStart = myRange.row + offsetRow
        colStart = myRange.Column + offsetCol
        '表の最後のセル番地を取得する
        rowLast = ws.Cells(rowStart, colStart).CurrentRegion.row + ws.Cells(rowStart, colStart).CurrentRegion.Rows.Count - 1
        colLast = ws.Cells(rowStart, colStart).CurrentRegion.Column + ws.Cells(rowStart, colStart).CurrentRegion.Columns.Count - 1
        Set myRange = ws.range(Cells(rowStart, colStart), Cells(rowLast, colLast))
    End If
    
    Set getTableRange = myRange
End Function

コードはすっきりしましたが、わりと技術的には複雑ですね。効率的に組むなら高度な技術が必要な場合もあります。

パーフェクトExcel VBA [ 高橋宣成 ] 価格:3608円 (2024/4/6 20:13時点) 感想(3件)

たった1秒で仕事が片づくExcel自動化の教科書【増強完全版】【電子書籍】[ 吉田拳 ] 価格:2178円 (2024/4/6 20:17時点) 感想(0件)