Microsoft Excel VBA - 特定の列でセルに数値0が入力されている行を削除する方法

◆概要
　数値0が入力されているセルに色をつける方法では、数値0が入力されているセルに色をつける方法を紹介しました。

　このページは、特定の列でセルに数値0が入力されている行を削除する方法について記載しています。
　データリストで、特定の列で０が入力されている場合にその行を削除したい場合があります。このようなときに利用するマクロです。

◆Sample
　次の例では、A列に契約番号が、B列に品名、C列に金額が入力されている場合に、C列の金額を調べ、０が入力されているとき、その行を削除します。

実行前サンプル

Option Explicit     ' 変数の宣言を強制する

Sub DeleteZeroRows()
' **********************************************
' Summary:0行削除マクロ
' Description:C列の値を調べ、0である場合は
'             その行を削除する
' Date:2009/07/11
' Written by:White Tiger
' **********************************************

    Dim lngRowCount As Long
    Dim i As Long
    
    Worksheets("sheet1").Range("C1").Select
    ' 画面の更新を抑止
    Application.ScreenUpdating = False
    ' リストの最終セルを選択する
    Selection.CurrentRegion.Select
    ' リストの行数
    lngRowCount = Selection.Rows.Count + 1

    For i = lngRowCount To 2 Step -1
        If Cells(i, 3) = 0 Then
            Rows(i).Select
            Selection.Delete Shift:=xlUp
        End If
    Next
    ' A1セルを画面の左上隅にする
    Application.Goto Reference:=Range("A1"), Scroll:=True
    ' 画面の更新を再開
    Application.ScreenUpdating = True
End Sub

◆実行結果
実行後サンプル

◆改良版
　上記の例の場合、100行のリストでは一瞬で終わりますが、5万行のリストでは17秒程度かかります（Core(TM)2 Duo CPU E8400 3.00GHzの場合）。
マクロ実行中は、アプリケーションが固まったようになりますので、DoEvents関数を使うとよいでしょう。また、ステータスバーに進行状況を表示する方法にあるようにステータスバーに進行状況を表示すると、ユーザーフレンドリーなアプリケーションになります。
次の例は、それに加えて処理時間を計測し、終了時にMsgBox関数でユーザーに処理の完了とかかった時間を通知します。5万行のリストで29秒程度かかります。

Option Explicit     ' 変数の宣言を強制する

Sub DeleteZeroRows()
' **********************************************
' Summary:0行削除マクロ
' Description:C列の値を調べ、0である場合は
'             その行を削除する
' Date:2009/07/11
' Written by:White Tiger
' **********************************************

    Dim lngRowCount As Long
    Dim i As Long
    
    Dim 初期状態 As Variant

    Dim Start As Single
    Dim Finish As Single
    
    ' 処理時間を計測ずる
    Start = Timer   ' 開始時間を変数に代入
    
    ' ステータスバーの現状を保存する
    初期状態 = Application.DisplayStatusBar
    
    Worksheets("sheet1").Range("C1").Select
    
    ' 画面の更新を抑止
    Application.ScreenUpdating = False
    
    ' カーソルを砂時計にする
    Application.Cursor = xlWait
    
    ' リストの最終セルを選択する
    Selection.CurrentRegion.Select
    
    ' リストの行数
    lngRowCount = Selection.Rows.Count + 1

    For i = lngRowCount To 2 Step -1
        If Cells(i, 3) = 0 Then
            Rows(i).Select
            Selection.Delete Shift:=xlUp
        End If
        Application.StatusBar = "マクロで処理中・・進行状況  " _
                    & Int((lngRowCount - i) / lngRowCount * 100) _
                    & " （100で終ります）"

        DoEvents        ' Applicationが固まらないようWindowsに処理を渡す
    Next
    
    ' ステータスバーを開放する
    Application.StatusBar = False
    
    ' ステータスバーを非表示にする
    Application.DisplayStatusBar = False
    
    ' ステータスバーを初期状態にもどす
    Application.DisplayStatusBar = 初期状態

    ' A1セルを画面の左上隅にする
    Application.Goto Reference:=Range("A1"), Scroll:=True
    
    ' 画面の更新を再開
    Application.ScreenUpdating = True
    
    ' マウスカーソルを既定値に戻す
    Application.Cursor = xlDefault
        
    Finish = Timer  ' 終了時間を変数に代入

    MsgBox "処理を完了しました。" & vbCrLf & _
        "かかった時間は" & Finish - Start & "秒です", _
        vbOKOnly + vbInformation, Title:="処理完了通知"

End Sub


▼ページトップへ

◆AutoFilter機能を使って一発削除
　さて、Excel使いのあなたなら、「そんなのAutoFilterを使えば一発でできる!」と思うでしょう。そう、上のように１行ずつ削除していては時間が掛かりすぎます。次の例はP列に減損償却額(会計)という項目があり、行によってはP列に０が入力されているリストをAutoFilter機能を使ってマクロで削除しています。また、マクロ実行前とマクロ実行後の列の合計を調べ、検算を行うようにしています。 このマクロの削除処理は、一瞬で削除します。

Sub DeleteZeloByAutoFilter()
' **********************************************************
' Summary:P列が０であるときは行を削除するマクロ
' Description:AutoFilter機能を使ってP列
'         の値が0である行を削除する。
'         このマクロは一瞬で終わる
' Date:2009/07/18
' Written by:White Tiger
' **********************************************************
    Dim intRowCount, i As Integer
    Dim lngTotal, lngWriteTotal As Long
    
    ' ユーザーに処理を実行するか確認する。
    If MsgBox("P列の値が０の行を削除します。" & vbCrLf & _
        "処理を実行しますか?", vbYesNo + vbQuestion, "0行削除マクロ") = vbNo Then
        Exit Sub    ' 処理を抜ける
    End If
    
    Application.ScreenUpdating = False
    
    ' マクロ実行前のP列の合計を変数に代入する
    lngTotal = WorksheetFunction.Sum(Range("P2:P10000"))
    
    Sheets(1).Activate
    Worksheets("sheet1").Range("P1").Select
    Selection.AutoFilter
    
    ' 使用されている最終セルを選択する
    Selection.CurrentRegion.Select
    ' 使用されている最終セルの行数
    intRowCount = Selection.Rows.Count + 1
    
    ' P列はR1C1形式で表現すると16列目なのでFieldに16を設定する
    ActiveSheet.Range("$A$1:$S$10000").AutoFilter Field:=16, Criteria1:="=0", _
        Operator:=xlAnd
    Rows("2:10000").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Application.Goto reference:=Range("A1"), Scroll:=True
    
    ' マクロ実行後のP列の合計を変数に代入する
    lngWriteTotal = WorksheetFunction.Sum(Range("P2:P10000"))
    
    Application.ScreenUpdating = True
    
    If lngTotal = lngWriteTotal Then
        MsgBox "処理を完了しました。" & vbCrLf & _
            "検算:OKです。" & vbCrLf & _
            "マクロ実行前のP列の合計:" & vbCrLf & lngTotal & vbCrLf _
            & "マクロ実行後のP列の合計:" & vbCrLf & lngWriteTotal, _
            Title:="0行マクロ実行結果通知"
    Else
    ' 検算の結果がNGのとき
        MsgBox "処理を完了しました。" & vbCrLf & _
            "検算：エラーです。" & vbCrLf & _
            "マクロ実行前のP列の合計:" & vbCrLf & lngTotal & vbCrLf _
            & "マクロ実行後のP列の合計:" & vbCrLf & lngWriteTotal, _
            vbOKOnly + vbInformation, Title:="0行マクロ実行結果通知"
    End If
    Exit Sub
End Sub

◆参考:▼数値0が入力されているセルに色をつける方法



▼ページトップへ