CurrentRegionに見出し行推定機能を追加する

表エリアの取得に非常に便利なCurrentRegionプロパティですが、
見出し上部のタイトルや注釈を取得してしまうという弱点があります。

この弱点を解消する改良型CurrentRegionを自作してみましたので、
よろしければ皆さんもご活用ください。

追加・改良する機能

CurrentRegionに以下の機能を追加します。

見出し行の直接指定機能を追加

そもそも行数が分かっていれば指定してあげればいい訳で、
Long型の第3引数でそれを指定できるようにします。

省略時は以下の仕様に則って見出し行を推定します。

テーブル・フィルターから実行した場合はその範囲を優先

テーブル・フィルターの内部のセルから実行した場合は、
AutoFilter.Range/ListObject.Rangeを取得します。

これにより、

この表で第2行を範囲に含めてしまうことを防げます。

要は「はっきりとした見出し行(▼)があればそれを優先する」という仕様ですね。

第1行よりデータの多い行があればそこを見出しに修正

この表でCurrentRegionを取得した場合は、
「第1行のデータ数がたったの1、第2行のデータ数は列数と同数の4」
という状況になっています。

このとき第1行と第2行以降を比較し、

• 列数-1のデータ数を持つ行があればその行を採用
• なければ上位5行のうち最大のデータ数の行を見出しに採用

という判定を行って見出しを推定します。

これにより、↓の表でも第3行を見出しとして取得してくれます。

列数と同数のデータではなく、列数-1を確定条件としているのは、

この手の「左上セルの値がなく斜線になっている表」で、
第3行を見出しと誤認しないためです。

これでかなり正確に見出しを推定してくれるようになります。

見出しを除外する機能を追加

CurrentRegionを使用する際、
目的がテーブル全体ではなくデータ部分だけということもよくあります。

その時は以下のようなコードで見出し部分を除外することになります。

' 表エリアのデータ部分だけを取得
Dim 表のデータ部分 As Range
Set 表のデータ部分 = Range("B3").CurrentRegion
Set 表のデータ部分 = 表のデータ部分.Offset(1)
Set 表のデータ部分 = 表のデータ部分.Resize(表のデータ部分.Rows.Count - 1)

　
これをいちいち指定しなくても済むように、
第3引数で「見出しを除外するか」を指定できるようにしました。

以上4つの機能を持たせた関数になります。

お好きなようにカスタマイズしてお使い下さい。

ソースコード

Function CurrentRegion改(起点セル As Range _
    , Optional ByVal 見出し行 As Long = -1, Optional ByVal is見出しを含む = True) As Range

    Dim ws対象シート As Worksheet
    Set ws対象シート = 起点セル.Worksheet

    ' まずは通常CurrentRegionをSet
    Set CurrentRegion改 = 起点セル.CurrentRegion

    ' 単独セルならそのまま返す
    If CurrentRegion改.Cells.Count = 1 Then Exit Function

    ' 見出し行が指定されていればその行より下でカットした範囲を取得
    If 見出し行 <> -1 Then
        Set CurrentRegion改 = Intersect(CurrentRegion改 _
            , Range(ws対象シート.Rows(見出し行), ws対象シート.Rows(ws対象シート.Rows.Count)))
        GoTo 返り値範囲調整
    End If
    
    ' 起点セルがListObject内であればListObject.Range
    If Not 起点セル.ListObject Is Nothing Then
        Set CurrentRegion改 = 起点セル.ListObject.Range
        GoTo 返り値範囲調整
    End If
    
    ' 起点セルがAutoFilter内であればAutoFilter.Range
    If ws対象シート.AutoFilterMode = True Then
        If Not Intersect(ws対象シート.AutoFilter.Range, 起点セル) Is Nothing Then
            Set CurrentRegion改 = ws対象シート.AutoFilter.Range
            GoTo 返り値範囲調整
        End If
    End If
    
    ' 上位5行のうち最大データ数の行を採用
    Dim R As Long
    Dim 現入力データ数 As Long
    Dim 最大入力データ数 As Long: 最大入力データ数 = 0
    Dim 採用見出し行 As Long: 採用見出し行 = 1
    For R = 1 To 5
        If R > CurrentRegion改.Rows.Count Then Exit For
        
        ' 現行の入力データ数を取得
        Dim 現在行 As Range: Set 現在行 = CurrentRegion改.Rows(R)
        現入力データ数 = WorksheetFunction.CountIf(現在行, "<>")
        
        ' 取得範囲の列数 - 1 を上回っていればそこを見出しと確定
        If 現入力データ数 >= CurrentRegion改.Columns.Count - 1 Then
            採用見出し行 = R
            Exit For
        End If
        
        ' 入力データ数が今までの行を上回る場合は採用行を更新
        If 現入力データ数 >= 最大入力データ数 Then
            採用見出し行 = R
            最大入力データ数 = 現入力データ数
        End If
        
    Next
    
    ' 採用した見出しで範囲をカット
    If 採用見出し行 > 1 Then
        Set CurrentRegion改 = Range(CurrentRegion改.Rows(採用見出し行) _
                                                    , CurrentRegion改.Rows(CurrentRegion改.Rows.Count))
        GoTo 返り値範囲調整
    End If

' 最後に見出しの有無を反映
返り値範囲調整:
    If CurrentRegion改 Is Nothing Then Exit Function
    
    ' 見出しを除外する場合
    If is見出しを含む = False Then
        
        ' 見出しだけしかなかった場合はNothingを返す
        If CurrentRegion改.Rows.Count = 1 Then
            Set CurrentRegion改 = Nothing
            Exit Function
        End If
        
        ' 1行目を除外した範囲を返す
        Set CurrentRegion改 = CurrentRegion改.Offset(1)
        Set CurrentRegion改 = CurrentRegion改.Resize(CurrentRegion改.Rows.Count - 1)
    
    End If

End Function