Excel 横方向の数値が全て0の行を削除する方法(2)VBAを作ってみた

前回、横方向の数値が全て0の行を、COUNTIFS関数を使って削除する方法について述べた。

Excel 横方向の数値が全て0の行を削除する方法(1)計算式を使用

2020年2月21日

今回は、これをVBAに書いてみたので載せてみる。

ソースコード

今回のVBAのソースコードが、下記の通り。

Option Explicit

Sub deleteAllZeroRows()
'選択範囲の横方向が、全て0の行を削除していく。
    Dim msg         As String: msg = "選択範囲の中で、横方向が、全て0の行を削除しますか？"
    
    If MsgBox(msg, vbQuestion + vbOKCancel, "確認") = vbCancel Then Exit Sub
    
    Call appSet '描画省略等
    
    Dim arr         As Variant
    Dim ws          As Worksheet: Set ws = ActiveSheet
    Dim rng         As Range: Set rng = Selection
    Dim cnt         As Long
    Dim startR      As Long
    Dim rSize       As Long
    Dim cSize       As Long
    
    arr = rng.Value
    
    '選択範囲が単一セルの場合は、arrが2次元配列にならないので
    'その単一セルが0かどうかだけ判定する
    If rng.Count = 1 Then
        If rng.Value * 1 = 0 Then
            rng.EntireRow.Delete
            cnt = 1 '削除した行数
        End If
        
        GoTo finish '処理を終える
    End If

    startR = rng(1).Row '選択範囲の開始行
    rSize = UBound(arr, 1) '行数
    cSize = UBound(arr, 2) '列数
    
    Dim deleteFlg       As Boolean
    Dim r               As Long
    Dim c               As Long
    
    '下の行から削除していく
    For r = rSize To 1 Step -1
        deleteFlg = True 'ループごとに初期値セット
        
        For c = 1 To cSize
            If arr(r, c) * 1 = 0 Then '0や空白であるか判定
            Else '1つでも0以外の数値があれば削除しない
                deleteFlg = False
                Exit For
            End If
        Next c
        
        '全て0や空白であれば、行ごと削除
        If deleteFlg Then
            ws.Cells(r + startR - 1, 1).EntireRow.Delete
            cnt = cnt + 1 '削除した行数の合計
        End If
    Next r
    
finish:
    
    '削除した行数(cnt)によりメッセージを変更する
    If cnt = 0 Then
        msg = "削除対象の行はありませんでした。"
    Else
        msg = "終了しました。合計" ＆ cnt ＆ "行を削除しました。"
    End If
    
    Call appReset '描画等を再開
    MsgBox msg, vbInformation, "処理終了"
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

Option Explicit

Sub deleteAllZeroRows()

'選択範囲の横方向が、全て0の行を削除していく。

Dim msg As String: msg = "選択範囲の中で、横方向が、全て0の行を削除しますか？"

If MsgBox(msg, vbQuestion + vbOKCancel, "確認") = vbCancel Then Exit Sub

Call appSet '描画省略等

Dim arr As Variant

Dim ws As Worksheet: Set ws = ActiveSheet

Dim rng As Range: Set rng = Selection

Dim cnt As Long

Dim startR As Long

Dim rSize As Long

Dim cSize As Long

arr = rng.Value

'選択範囲が単一セルの場合は、arrが2次元配列にならないので

'その単一セルが0かどうかだけ判定する

If rng.Count = 1 Then

If rng.Value * 1 = 0 Then

rng.EntireRow.Delete

cnt = 1 '削除した行数

End If

GoTo finish '処理を終える

End If

startR = rng(1).Row '選択範囲の開始行

rSize = UBound(arr, 1) '行数

cSize = UBound(arr, 2) '列数

Dim deleteFlg As Boolean

Dim r As Long

Dim c As Long

'下の行から削除していく

For r = rSize To 1 Step -1

deleteFlg = True 'ループごとに初期値セット

For c = 1 To cSize

If arr(r, c) * 1 = 0 Then '0や空白であるか判定

Else '1つでも0以外の数値があれば削除しない

deleteFlg = False

Exit For

End If

Next c

'全て0や空白であれば、行ごと削除

If deleteFlg Then

ws.Cells(r + startR - 1, 1).EntireRow.Delete

cnt = cnt + 1 '削除した行数の合計

End If

Next r

finish:

'削除した行数(cnt)によりメッセージを変更する

If cnt = 0 Then

msg = "削除対象の行はありませんでした。"

Else

msg = "終了しました。合計" ＆ cnt ＆ "行を削除しました。"

End If

Call appReset '描画等を再開

MsgBox msg, vbInformation, "処理終了"

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

解説等

「deleteAllZeroRows」というのが本体のマクロで、「appSet」「appReset」というのはExcelの描画を省略するなどVBAの高速化に関係するもの。

Excel 個人用マクロブック(Personal.xlsb) 最初に必ず入れておく高速化用コード

2021年8月10日

GoToというのを使って無理やり最後のfinishという場所に飛ばす処理を入れているが、もう少しスマートにすべきなのだろう。
このGoToは通常、あまり推奨はされない手法だ。
ループ変数rを使ったループは、
step -1
という書き方で、大きい数から小さい数へ逆順にループさせている。
特に行の削除などという処理は、行削除したときに行番号が変化してしまうのを防ぐために、こうやって一番下の行から削除していくのがセオリーだ。
横方向が全て0の行を削除するということだが、通常のExcel関数などでは面倒な、「空白セルの場合も0として扱う」処理を
arr(r, c) * 1 = 0
みたいに、結果に1を乗じるという方法で記述した。
これなら空白の場合も掛け算の結果は0になるということで、これは通常のExcelの計算式においても使える技だ。
2次元配列というのを使っているが、それはこちらの記事を参照。