値や数式が一つもない空行を一括で削除するマクロを紹介します。
こういった表でフィルターがちゃんと動かない問題などに対応する際、
ワンボタンで削除までやってくれるマクロですね。
アクティブシートに実行するタイプの便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。
ショートカットキーに登録したり、ツールバーやリボンにボタン配置すると便利です。
削除するマクロですので、「元に戻す」ができない点だけは注意してくださいね。
ソースコード
※ シート内のすべての空行を削除してしまうと、
表上部の余白なども消えてしまって困ることがあるため、
「選択中のエリアにかかる空行」だけを削除するコードです。
Sub 選択エリアにかかる空行を一括削除する() ' 選択範囲がUsedRangeを超えないように交差範囲に実行 Dim 実行エリア As Range Set 実行エリア = Intersect(Selection, ActiveSheet.UsedRange) ' 実行エリアの第1行から最終行までの間の空行を削除 Call 空行を一括削除する(ActiveSheet _ , 実行エリア.Row _ , 実行エリア.Rows.Count + 実行エリア.Row - 1) End Sub ' 空行を削除する汎用関数 Sub 空行を一括削除する(ws As Worksheet, R1st As Long, RLast As Long) ' 対象行をすべて判定 Dim R As Long Dim rows削除対象 As Range For R = R1st To RLast ' 空行であれば削除対象に追加 If WorksheetFunction.CountIf(ws.Rows(R), "<>") = 0 Then If rows削除対象 Is Nothing Then Set rows削除対象 = ws.Rows(R) Else Set rows削除対象 = Union(rows削除対象, ws.Rows(R)) End If End If Next ' 削除範囲を一括削除 If Not rows削除対象 Is Nothing Then rows削除対象.Delete End Sub
解説
「空の行を削除する」というのは普通のマクロでも活用できて便利なので、
使いまわすための汎用関数と、その関数をCallしてActiveSheetに実行する便利マクロの2つのSubプロシージャに分けました。
先にメインコードである「汎用関数」側を解説しますと、
まずFor文でRを開始行から終了行までループし、
「COUNTIF(対象行, "<>")=非空セル数」が0の行を判定します。
その該当行をUnionメソッドを使って1つのRangeオブジェクトにまとめておき、
For文の処理が終わった後で一括で削除しています。
わざわざRangeオブジェクトに入れてから削除しているのは、
1行1行削除するよりも高速になるからというのもありますが、
1行ずつ削除するとそのたびに判定行数に調整が必要になってしまうからです。
(4行目を削除したら、次は4行目をもう一度みないといけない)
ちなみに使うシート関数ですが、
- COUNTA:完全に空のセルかどうかを判定
- COUNTIF("<>"):数式によって""になっているセルも空セルに含んで判定
という違いがありますのでお好きな方をお使いください。
あとは実行マクロの方ですが、
こちらは汎用関数をActiveSheetとSelectionで動かしているだけです。
単にSelectionを渡すと全セル選択時に固まってしまうので、
Intersectメソッドを用いてUsedRangeをオーバーしないようにしています。
また、今回は書きませんでしたが、
実行側にOn Error Resume Nextを書いておくのもひとつの手です。
シートの保護やテーブルなど、削除が禁止された操作では、
このコードは失敗してデバッグ画面に入ってしまいます。
自分で使う分にはその方が都合が良かったりしますが、
人に配布するときはOn Error Resume Next版の方がいいかもしれません。
お好きな方で実装してください。
このようにマクロの一部を汎用関数として抜き出しておくと、
使い勝手がいい部分だけを他のマクロで使いまわせます。
今回のように、
「汎用関数にActiveSheetやSelectionを渡すと汎用マクロとしても使える」
というパターンはなかなか便利ですので覚えておきましょう。
別策:イミディエイトウィンドウを使ったワンライナー
マクロをリボンやショートカットに登録できないときは、
イミディエイトウィンドウを使って実行することもできます。
イミディエイトウィンドウに以下のコードを入力すると、
空セルを含んだ行を一括で削除することができます。
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ゆっくり翻訳しながら読むだけでもわかると思いますが、
選択エリア内の空セルSpecialCells(xlCellTypeBlanks)を含む行EntireRowを削除
するコードですね。
この1行だけで、なかなか便利な動きをしてくれます。
ただし注意点として、このコードは「空行」ではなく「空セルを含む行」を削除します。
例えば「A列が空の行」を一括削除できますが、
A~G列がすべて空の行はこのコードでは判定できませんのでご注意ください。
ちなみにこのコードを活用する場合は、ユーザー辞書に登録するという手があります。
ワンライナーは辞書登録にうってつけですので、
この処理をよくやる方は登録を検討してみてください。
おまけ:さらに汎用関数を作る
上記のコードで煩わしいのがこの部分です。
If rows削除対象 Is Nothing Then Set rows削除対象 = ws.Rows(R) Else Set rows削除対象 = Union(rows削除対象, ws.Rows(R)) End If
これ、
Set rows削除対象 = Union(rows削除対象, ws.Rows(R))
こう書くだけで動いてよっていつも思うんですよね。
Nothing+Range("A1") = Range("A1")
でいいじゃんと思うのですが、UnionメソッドはNothingを受け取らないため、
わざわざこのようなIfステートメントが必要になります。
和集合(A ⋃ B)の「⋃」ってUnionの頭文字なのに、
和集合の定理(A ⋃ ∅ = A)を満たしてないのはいかがなものか。
ということで、いちいちUnionを分岐しなくていいように、
改良型Union関数を作ってしまいましょう。
それがこちら
Sub 空行を一括削除する(ws As Worksheet, R1st As Long, RLast As Long) ' 対象行をすべて判定 Dim R As Long Dim rows削除対象 As Range For R = R1st To RLast ' 空行であれば削除対象に追加 If WorksheetFunction.CountIf(ws.Rows(R), "<>") = 0 Then Set rows削除対象 = UnionEx(rows削除対象, ws.Rows(R)) End If Next ' 削除範囲を一括削除 If Not rows削除対象 Is Nothing Then rows削除対象.Delete End Sub ' Union改 Function UnionEx(Arg1 As Range, Arg2 As Range) As Range If Arg1 Is Nothing Then Set UnionEx = Arg2 ElseIf Arg2 Is Nothing Then Set UnionEx = Arg1 Else Set UnionEx = Union(Arg1, Arg2) End If End Function
メインコードが劇的にスッキリしましたね。
Ifひとつ減らすだけでもコードが4行も減りますし、
For内のインデントが減るだけでもだいぶ見違えます。
この関数を持っておくと、Rangeオブジェクトの結合がとても楽になります。
Unionメソッドをよく使う人は、この機会に作ってみてください。