Excelの選択範囲をデータのある範囲に縮小する

SHIFT+CTRL+↓でもいいのですが

エクセルでデータを処理する場合に、セル範囲を厳密に選ぶのは結構面倒です。例えば、2000行のデータがあったとして、間に空白セルも含まれている、というような場合、SHIFT+CTRL+→キーだと繰り返し操作が必要にります。
また、各種マクロの前処理として選択範囲をデータのある範囲に狭めたい場合があります。

そこで、選択範囲をデータのある範囲に縮小するマクロを作成しました。

使用方法

セル範囲、行、列、またはシート全体を選択し、マクロを実行します。

コード

Sub shrinkSelectionRange()
    'シート全体が選択されている場合
    If Selection.Columns.Count = Columns.Count And Selection.Rows.Count = Rows.Count Then
        'Usedrangeを使って手抜き
        ActiveSheet.UsedRange.Select
    Else
        'そうでない場合は行列方向に個別処理
        Call shrinkSelectionRow
        Call shrinkSelectionColumn
    End If
End Sub

Sub shrinkSelectionRow()
    Dim maxRowCount As Long, minRowCount As Long
    Dim response As Integer
    
    With Selection
        '列が選択されているとき（行数がエクセルの最大行数と等しいならば）
        If .Rows.Count = Rows.Count Then
            'シート全体が選択されている場合（列数もエクセルの最大列数と等しいならば）
            If .Columns.Count = Columns.Count Then
                response = MsgBox("処理に時間が掛かりますが、良いですか？", vbYesNo, "shrinkSelectionRow")
                If response = vbNo Then Exit Sub
            End If
        
            maxRowCount = 1
            For i = 1 To .Columns.Count
                If .Cells(Rows.Count, i).End(xlUp).Row > maxRowCount Then
                    maxRowCount = .Cells(Rows.Count, i).End(xlUp).Row
                End If
            Next
            
            minRowCount = Rows.Count
            For i = 1 To .Columns.Count
                If .Cells(1, i).Value <> "" Then
                    minRowCount = 1
                    Exit For
                End If
                If .Cells(1, i).End(xlDown).Row < minRowCount Then
                    minRowCount = .Cells(1, i).End(xlDown).Row
                End If
            Next
            
            Range(.Rows(minRowCount), .Rows(maxRowCount)).Select
        End If
    End With
End Sub

Sub shrinkSelectionColumn()
    Dim maxColumnCount As Long, minColumnCount As Long
    
    With Selection
        '行が選択されているとき（列数がエクセルの最大列数と等しいならば）
        If .Columns.Count = Columns.Count Then
            'シート全体が選択されているとき（行数もエクセルの最大行数と等しいならば）
            If .Rows.Count = Rows.Count Then
                response = MsgBox("処理に時間が掛かりますが、良いですか？", vbYesNo, "shrinkSelectionColumn")
                If response = vbNo Then Exit Sub
            End If
            
            maxColumnCount = 1
            For i = 1 To .Rows.Count
                If .Cells(i, Columns.Count).End(xlToLeft).Column > maxColumnCount Then
                    maxColumnCount = .Cells(i, Columns.Count).End(xlToLeft).Column
                End If
            Next
            
            minColumnCount = Columns.Count
            For i = 1 To .Rows.Count
                If .Cells(i, 1).Value <> "" Then
                    minColumnCount = 1
                    Exit For
                End If
                If .Cells(i, 1).End(xlToRight).Column < minColumnCount Then
                    minColumnCount = .Cells(i, 1).End(xlToRight).Column
                End If
            Next
            
            Range(.Columns(minColumnCount), .Columns(maxColumnCount)).Select
        End If
    End With
End Sub