前の行をチェックして削除したときに行チェックがスキップされないようにするにはどうすればよいですか？

Question

これは、2つの列をループして、L列の値が別のシートのセルの特定の（単一の）値よりも低いことを確認するためのものです。また、列Mの同じ行にあるセルに「＃N/A」エラーがあるかどうかを確認します。これらが真の場合、行全体が削除されます。下のコードは動作するようですが、Forループを複数回実行してすべての行を完全に削除する必要があります。私の勘は、行が削除されたときに、その行のすぐ下にある行をチェックして移動していないということです。どうすればこれを避けることができますか？どんな助けもありがとうございます。

Sub removerows() 

Dim wsOut As Worksheet 
Dim wsPrev As Worksheet 
Dim r As Long 
Dim Lastrow As Long 

Set wsOut = Worksheets("Output") 
Set wsPrev = Worksheets("Previous") 
Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row 

For r = 2 To Lastrow 
    If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _ 
     Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then 
       wsOut.Cells(r, "L").EntireRow.Delete 
     Else 
      wsOut.Cells(r, "L").Interior.ColorIndex = 20 
    End If 
Next 

End Sub 

Answer 1

逆ループを実行します。

For r = 2 To LastrowからFor r = Lastrow to 2 Step -1に変更してください。

私はモバイルでテストしていませんでしたが、これで問題が解決するはずです。

Answer 2

Sub removerows() 

    Dim wsOut As Worksheet 
    Dim wsPrev As Worksheet 
    Dim r As Long 
    Dim Lastrow As Long 

    Set wsOut = Worksheets("Output") 
    Set wsPrev = Worksheets("Previous") 
    Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row 

    For r = Lastrow To 2 step -1 
     If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _ 
      Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then 
        wsOut.Cells(r, "L").EntireRow.Delete 
      Else 
       wsOut.Cells(r, "L").Interior.ColorIndex = 20 
     End If 
    Next 

End Sub 

あなたが削除している場合は、ループを逆にすることです。

Answer 3

あなたはそれをスピードアップし、AutoFilter()を使用してループを避けることができます：

Option Explicit 

Sub removerows() 
    Dim prevValue As Double 

    prevValue = Worksheets("Previous").Range("L2") 
    With Worksheets("Output") '<--| reference your "output" sheet 
     With .Range("M1", .Cells(.Rows.count, "L").End(xlUp)) '<--| reference its columns "L:M" range from row 1 (header) down to column "L" last not empty row 
      .AutoFilter Field:=1, Criteria1:="<" & prevValue '<--| 1st filter on column "L" with values lower than sheet "previous" sheet "L2" cell 
      .AutoFilter Field:=2, Criteria1:="#N/A" '<--| '<--| 2nd filter on column "M" with values "#N/A" values 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete '<--| if any filtered cells then delete their row 
      .AutoFilter '<--| remve filters 
      .AutoFilter Field:=1, Criteria1:=">=" & prevValue '<--| filter on column "L" with values greater or equal than sheet "previous" sheet "L2" cell 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then .Resize(.Rows.count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 20 '<--| if any filtered celld then color them 
     End With 
    End With 
End Sub 

Answer 4

ただ、R =追加 - 行が削除された後、1。

Sub removerows() 

Dim wsOut As Worksheet 
Dim wsPrev As Worksheet 
Dim r As Long 
Dim Lastrow As Long 

Set wsOut = Worksheets("Output") 
Set wsPrev = Worksheets("Previous") 
Lastrow = wsOut.UsedRange(wsOut.UsedRange.Cells.Count).Row 

For r = 2 To Lastrow 
    If wsOut.Cells(r, "L").Value < wsPrev.Cells(2, "L").Value And _ 
     Application.WorksheetFunction.IsNA(wsOut.Cells(r, "M").Value) Then 
       wsOut.Cells(r, "L").EntireRow.Delete 
    *****  r = r -1 'Done! it will recheck the same cell after 
     Else 
      wsOut.Cells(r, "L").Interior.ColorIndex = 20 
    End If 
Next 

End Sub