指定列のデータ部分だけを選択するマクロ

表形式のデータを加工する際、↓のエリアを選択したいことがよくあります。

他のシートにコピーしたり、第1セルの数式を列全体にコピーしたり、
ここを選択する作業は結構多いんじゃないかと思います。

このときCtrl+Shift+↓が使えるならなんてことはないのですが、
画像のように空セルがあるとこの範囲の選択は結構面倒です。

ということでこれを自動でやってくれるマクロを作りましょう。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

このマクロはショートカットキーにセットするのがおすすめです。

マクロの仕様

選択中の範囲を含む列のデータ部分を選択しなおします。

単独セルからの実行

列全体からの実行

肝心の「データ部分」の判定は

• フィルターやテーブルがあればそのデータ範囲(見出し除く)
• なければCurrentRegionから見出しを除いた範囲
• CurrentRegionが見出し上部を取得する問題にも対応

という判定を行って対象範囲を取得します。

※ CurrentRegionが苦手な見出し上部の誤取得がこれ↓

なかなか使い勝手のいいマクロですのでご活用ください(´∀｀)

ソースコード

' 列のデータ部分の選択マクロ
Sub 選択列のデータ部分を選択する()

    Dim 選択範囲 As Range: Set 選択範囲 = Selection

    ' 選択範囲を含むCurrentRegion(改良版)を取得
    Dim データ範囲全体 As Range
    Set データ範囲全体 = CurrentRegion改(選択範囲, , False)
    
    If データ範囲全体 Is Nothing Then Exit Sub
    
    ' CurrentRegionが単独セルになってしまう場合は選択列の第1入力セルから取り直す
    ' ※ 主に列全体を選択時に第1入力セルから表エリアを取得するための処理
    If データ範囲全体.Cells.Count = 1 Then
        Dim セル As Range
        For Each セル In Selection.Cells
            If セル.Text <> "" Then
                Set データ範囲全体 = CurrentRegion改(セル, , False)
                Exit For
            End If
        Next
    End If
    
    ' 上手く範囲が取れない場合はExit
    If データ範囲全体 Is Nothing Then Exit Sub
    If データ範囲全体.Cells.Count = 1 Then Exit Sub
    
    ' 取得したデータ範囲全体.EntireRowと選択範囲.EntireColumnのIntersectを選択
    Dim 取得範囲 As Range
    Set 取得範囲 = Intersect(データ範囲全体.EntireRow, 選択範囲.EntireColumn)
    
    If Not 取得範囲 Is Nothing Then 取得範囲.Select

End Sub

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

解説

かなり長大なコードになっていますが、大部分がCurrentRegionの改良コードです。

この「CurrentRegion改」というFunctionは前述の

この誤取得がなるべく起きないよう調整した関数で、

• テーブル・フィルターから実行した場合はその範囲を優先
• 第1行よりデータの多い行があればそこを見出しに修正
• 見出しを含める/除外する設定を選択できる引数を追加

という機能を持たせています。

今回のマクロ以外にも非常に便利な関数ですので、
自分のマクロに組み込む関数としてもご活用ください。

詳しくはこちらの記事を解説していますのでどうぞ。

あとは選択セルを含む列全体とCurrentRegion改の取得エリアを、
Intersectによって交差範囲として取得しているだけです。

一応、細かく気づかいしなければいけない点として、
列全体.Currentregionは第1セル.CurrentRegionとみなされるため、
上部が空セルだとうまく範囲を取得できません。

この場合はソースコードのようにForEachで各セルを回し、
最初の入力セルからCurrentRegionを取り直す必要があります。

実装はちょっと面倒ですが、このマクロは列全体から実行できると便利ですので、
致し方ない工数ですね。