勇気が出てくる言霊

アインがあなたの未来を占います

条件を満たす行を削除する

 

条件を満たす行を削除する

 

ループで削除する　　　Topへ

  • 複数のばらばらな行を削除するときは、ループで後ろの方から削除するのが基本です。
    なぜなら、行を削除すると、行位置が1つ前にずれてくるのでループすると都合が悪いのです。
    つまり、2行目を削除したら3行目のデータが2行目に移動します。ループのカウンターは2ですから、次は3・・・ずれる前の4行目が次の対象になってしまうからです。

不都合なコードの例

  • 実行前の状態
    申込数が 0 の行を削除します。
  • 不都合なコード
    行の先頭から削除すると・・・ダメな例です。
    Sub test01()
    　Dim i As Long
    　　For i = 2 To 10
    　　　　If Cells(i, 2).Value = 0 Then
    　　　　　　Range(i & ":" & i).Delete
    　　　　End If
    　　Next i
    End Sub
  • 実行後の状態

行を削除するコードの例

  • 下表の申込数が0の行を削除します。
  • コードの例
    1行ずつ削除すると画面がちらつきますので、Application.ScreenUpdating = False　で画面表示を止めて削除しています。
    Sub test01a()
    　Dim lRow As Long
    　Dim i As Long
    　　lRow = Cells(Rows.Count, 1).End(xlUp).Row
    　　Application.ScreenUpdating = False
    　　For i = lRow To 2 Step -1
    　　　　If Cells(i, 2).Value = 0 Then
    　　　　　　Range(i & ":" & i).Delete
    　　　　End If
    　　Next i
    　　Application.ScreenUpdating = True
    End Sub
    • 削除部分は　Cells(i, 2).EntireRow.Delete　とすることもできます。
  • 実行後

配列を利用して削除する

  • 対象のデータが配列に読み込める程度のデータ量である場合、配列にデータを読み込み必要なデータのみにしてから書き出すことができます。
  • なお、この方法ではループ中に行位置は変わらないので、ループは前の方からでよいことになります。
    Sub test03()
    　Dim lRow As Long, lCol As Long
    　Dim i As Long, j As Long
    　Dim x, y
    　Dim myCnt As Long
    　　lRow = Cells(Rows.Count, 1).End(xlUp).Row
    　　lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    　　'----データを配列Xに読み込む
    　　x = Range(Cells(1, 1), Cells(lRow, lCol)).Value
    　　'----データを書き出す配列yを準備する
    　　ReDim y(1 To lRow, 1 To lCol)
    　　For i = 1 To lRow
    　　　　'----削除しないデータを配列yに書き込む
    　　　　If x(i, 2) <> 0 Then
    　　　　　　myCnt = myCnt + 1
    　　　　　　For j = 1 To lCol
    　　　　　　　　y(myCnt, j) = x(i, j)
    　　　　　　Next j
    　　　　End If
    　　Next i
    　　'----配列yをシートへ書き出す
    　　Range("A1").Resize(lRow, lCol).Value = y
    End Sub
    • なお、条件は If Not x(i, 2) = 0 Then　としてもよいと思います。

空白行を削除する

  1. 空白セルの行を削除する場合は、条件を Cells(i, 1).Value ="" とします。
    ここでは、A列のセルの値=""　としていますので、数式で""が返されているセルも削除対象となります。
    Sub test0b()
    　Dim lRow As Long
    　Dim i As Long
    　　lRow = Cells(Rows.Count, 1).End(xlUp).Row
    　　Application.ScreenUpdating = False
    　　For i = lRow To 2 Step -1
    　　　　If Cells(i, 1).Value ="" Then
    　　　　　　Range(i & ":" & i).Delete
    　　　　End If
    　　Next i
    　　Application.ScreenUpdating = True
    End Sub
    • 実行前
    • 実行後
  2. 空白セルの判定をVarType(Cells(i, 1)) = vbEmptyとすると、"" が入っているセルは削除されません。
    • If IsEmpty(Cells(i, 1)) Then　とすることもできます。
    Sub test0c()
    　Dim lRow As Long
    　Dim i As Long
    　　lRow = Cells(Rows.Count, 1).End(xlUp).Row
    　　Application.ScreenUpdating = False
    　　For i = lRow To 2 Step -1
    　　　　 If VarType(Cells(i, 1)) = vbEmpty Then
    　　　　　　Range(i & ":" & i).Delete
    　　　　End If
    　　Next i
    　　Application.ScreenUpdating = True
    End Sub
    • 実行前
    • 実行後