2017-01-02 3 views
1

Dies ist vorgesehen, um durch zwei Spalten zu gehen und zu überprüfen, dass der Wert in der L-Spalte niedriger als ein bestimmter (einzelner) Wert in einer Zelle von einem anderen Blatt ist. Außerdem wird überprüft, ob in der Zelle in derselben Zeile in Spalte M ein "# N/V" -Fehler vorliegt. Wenn dies der Fall ist, wird die gesamte Zeile gelöscht. Der Code unten scheint zu funktionieren, jedoch muss ich die For-Schleife mehrmals ausführen, um alle Zeilen vollständig zu löschen. Meine Vermutung ist, dass wenn eine Zeile gelöscht wird, sie nicht die darunterliegende prüft und weitergeht. Wie kann ich das vermeiden? Jede Hilfe wird geschätzt.Wie verhindert man, dass die Zeilenprüfung übersprungen wird, wenn die vorherige Zeile geprüft und gelöscht wird?

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 
+3

Wenn Sie eine Zeile löschen, werden Sie die nächste Zeile zu der r-ten Position „Förderung“ (die aktuelle Zeile ersetzt), so dass, wenn Sie auf den nächsten r erhöhen, überspringt es natürlich die Zeile, die Sie gerade gestoßen oben. Es sieht auch so aus, als ob Sie unten ein Problem haben, da Lastrow (die Anzahl der Gesamtzeilen) gleich bleibt, obwohl Sie Zeilen gelöscht haben. – vknowles

Antwort

2

Eine umgekehrte Schleife ausführen.

Ändern Sie For r = 2 To Lastrow zu For r = Lastrow to 2 Step -1.

Habe es nicht getestet, da ich auf dem Handy bin, aber das sollte dein Problem lösen.

+0

Das ist der eine. Vielen Dank! – lookininward

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 = 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 

Die Idee ist, die Schleife rückwärts zu machen, wenn Sie löschen.

0

Sie könnte es beschleunigen und vermeiden Schleifen durch die Verwendung von 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 
0

Gerade r = r hinzufügen - 1 nach der Zeile gelöscht wird.

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 
Verwandte Themen