Excel 最終セルを求めて不要な行・列を削除する(2)VBAでやってみる

前回、Excelの最終セルに関して扱った。
それを今回は、Excel VBAの場合についてはどうなるか述べていく。

Excel 最終セルを求めて不要な行・列を削除する(1)通常Excel操作

2020年2月23日

単純に最終セルにジャンプする

VBAで、Excelシートの最終セルを単純に取得するのは
Cells.SpecialCells(xlCellTypeLastCell)
を使う。

だからExcelの通常操作で
Ctrl + End
をするのと同様に、アクティブシートの最終セルにジャンプしたいなら
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Select
で良い。

さてこの場合、
SpecialCells(xlCellTypeLastCell)
でジャンプする最終セルは、下図でいうと茶色のセルとか罫線の関係でJ500000セルとなる。

実用上の最終セルを求めたい

しかし通常は最終セルとしてジャンプしたいのは、一覧表の最終点であるG6セルのはずだ。
これを「実用上の最終セル」と呼ぶことにするが、これをVBAでどう求めるかというのが今回の本題だ。

この「実用上の最終セル」の求め方に、完璧な正解と言えるものは無いはずではある。
Excelシートがもっと複雑でデータがあちこち点在している場合などは、どこを「実用上の最終セル」と言うのかは、意見が分かれるケースもあるはずだ。

今回はその解答の一つとして、何らかの文字が見つかる最終セルを探し出す手法による。
上図のG500000セルのように、色だけが付いていて文字も数式もないセルは、最終セルとしての認識から外すということだ。

ソースコード

それではソースコードを載せる。
今回は、シート上で何らかの文字があるセルを検索するのに、Findメソッドを使用している。

もっとも私は、配列とかを多用するし、セルを愚直に検索するFindメソッドはあまり好んで使用しない。
だからFindメソッドについて、今回はあれこれ述べはしない。

ただ、Findメソッドを普通に使うと結果としてRangeオブジェクト(要はセルのこと)が返ってきてそのセルにジャンプしてしまう。
だからそういう余計なジャンプとかを防ぐために、Findメソッドの最後にRowとか付けて、数値だけが結果として返るようにするというのも、他のマクロでも使える技のはず。

下のマクロで「deleteExtraRowColumn」というやつが、不要な行・列を削除する処理まで含んだ一連のマクロだ。

そしてその途中で呼び出す「findEndRC」というやつも、単純に実用上の最終セルを求めたいだけなら単体で使えるマクロだ(中に引数を入れる必要はあるが)。

Option Explicit

Sub deleteExtraRowColumn()
'実用上の最終セルを求め、不要な行・列は削除する。
    Dim ws      As Worksheet: Set ws = ActiveSheet
    
    '単純な最終セルのアドレスを書き出してみる
    Debug.Print "単純な最終セル=" ＆ ws.Cells.SpecialCells(xlCellTypeLastCell).Address
    
    Dim endR    As Long '最終行
    Dim endC    As Long '最終列
    
    Call appSet '描画省略等
    
    '実用上の最終セルを求める
    Call findEndRC(ws, endR, endC)
    
    '実用上の最終セル以降の、不要な行・列を削除
    Range(ws.Cells(endR + 1, 1), ws.Cells(Rows.Count, 1)).EntireRow.Delete
    Range(ws.Cells(1, endC + 1), ws.Cells(1, Columns.Count)).EntireColumn.Delete
    
    Call appReset '描画などの設定をリセット
End Sub

Sub findEndRC(ws As Worksheet, endR As Long, endC As Long)
'実用上の最終セルを求める。
'使用されているセル(UsedRange)の中で何らかの文字(What:="*")があるセルを、
'最終セルlastRngから始まって逆順(SearchDirection:=xlPrevious)で検索。

    
    Dim lastRng     As Range

    With ws.UsedRange
        Debug.Print "使用中セル=" ＆ .Address
        
        Set lastRng = .SpecialCells(xlCellTypeLastCell)
        endR = .Find(What:="*", After:=lastRng, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row  '最終行
            
        endC = .Find(What:="*", After:=lastRng, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column  '最終列
    End With
    
    Debug.Print "実用上の最終セル=R" ＆ endR ＆ "C" ＆ endC
    
'特殊な検索(Find)をしたので、その形跡を消すため、一般的な検索をしておく。
    Dim num         As Long
    
    num = ws.Cells.Find(What:="", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False, SearchFormat:=False).Row
End Sub


Sub appSet()
'マクロ処理中に、描画など余計なものを省略して高速化
    With Application
        .ScreenUpdating = False '描画を省略
        .Calculation = xlCalculationManual '手動計算
        .DisplayAlerts = False '警告を省略。
'        .EnableEvents = False
    End With
End Sub

Sub appReset()
'描画などの設定をリセット
    With Application
        .ScreenUpdating = True '描画する
        .Calculation = xlCalculationAutomatic '自動計算
        .DisplayAlerts = True '警告を行う
    End With
End Sub