刪除所有包含值爲VBA的行

Question

我一直在努力工作的時間超過了我想承認的範圍。我正在比較兩個工作表（A & B）。我正在循環訪問A列（「B」），並且對於該列中的每個值，我都會根據B列（「C」）進行檢查。如果有匹配，我想刪除整行。

我已經做了許多不同的方法，我只是無法讓它工作。這是原件：

Option Explicit 

Sub Purge() 

Dim wipWS   As Worksheet 
Dim invWS   As Worksheet 
Dim C    As Range 
Dim SourceLastRow As Long 
Dim DestLastRow  As Long 
Dim LRow   As Long 
Dim D    As Range 

Set wipWS = Worksheets("Work in Process") 
Set invWS = Worksheets("Inventory Allocation") 

With wipWS 
' find last row in Work in Process Column B 
SourceLastRow = .Cells(.Rows.count, "E").End(xlUp).Row 

' find last row in Inventory Allocation Column C 
DestLastRow = invWS.Cells(invWS.Rows.count, "B").End(xlUp).Row 

' define the searched range in "Inventory Allocation" sheet 
Set C = invWS.Range("B1:B" & DestLastRow) 

Set D = wipWS.Range("E1:E" & SourceLastRow) 


    ' allways loop backwards when deleting rows or columns 
    ' choose 1 of the 2 For loops below, according to where you want to delete 
' the matching records 

' --- according to PO request delete the row in Column B Sheet A 
' and the row in Column C in "Inventory Allocation" worksheet 
' I am looping until row 3 looking at the PO original code 
For LRow = SourceLastRow To 1 Step -1 

    ' found a match between Column B and Column C 
    If Not IsError(Application.Match(.Cells(LRow, "E"), C, 0)) Then 
     .Cells(LRow, 2).EntireRow.Delete Shift:=xlUp 
     invWS.Cells(Application.Match(.Cells(LRow, "E"), C, 0), 2).EntireRow.Delete Shift:=xlUp 
    End If 
    Next LRow 
End With 

End Sub 

它的工作原理，除了留下1行（應該刪除）。我想我知道爲什麼會發生，除非我不知道如何去做。我已經嘗試了一個For循環，它的工作原理，除了我必須設置一個範圍（例如，「A1：A200」），我希望它只根據行數循環。

任何幫助將不勝感激！

Answer 1

，而不是運行2個循環的哪一行，你可以運行在YOUT工作表1個For環路（「工作），掃描B列，然後僅使用Match函數在整個C範圍內搜索該值 - 在C列中設置爲工作表（「庫存分配」）（直到具有數據的最後一行）。

注意：刪除行時，總是使用反向循環（For循環向後計數）。

代碼

Option Explicit 

Sub Purge() 

Dim wipWS   As Worksheet 
Dim invWS   As Worksheet 
Dim C    As Range 
Dim SourceLastRow As Long 
Dim DestLastRow  As Long 
Dim LRow   As Long 

Set wipWS = Worksheets("Work in Process") 
Set invWS = Worksheets("Inventory Allocation") 

With wipWS 
    ' find last row in Sheet A Column B 
    SourceLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 

    ' find last row in Sheet B Column C 
    DestLastRow = invWS.Cells(invWS.Rows.Count, "C").End(xlUp).Row 

    ' define the searched range in "Inventory Allocation" sheet 
    Set C = invWS.Range("C1:C" & DestLastRow) 

    ' allways loop backwards when deleting rows or columns 
    ' choose 1 of the 2 For loops below, according to where you want to delete 
    ' the matching records 

    ' --- according to PO request delete the row in Column B Sheet A 
    ' and the row in Column C in "Inventory Allocation" worksheet 
    ' I am looping until row 3 looking at the PO original code 
    For LRow = SourceLastRow To 3 Step -1 

     ' found a match between Column B and Column C 
     If Not IsError(Application.Match(.Cells(LRow, "B"), C, 0)) Then 
      .Cells(LRow, 2).EntireRow.Delete Shift:=xlUp 
      invWS.Cells(Application.Match(.Cells(LRow, "B"), C, 0), 3).EntireRow.Delete Shift:=xlUp 
     End If 
    Next LRow    
End With 

End Sub 

Answer 2

您正在比較兩個工作表（A & B）。你想通過A列（「B」）循環，並且對於該列中的每個值，檢查B列（「C」）。 所以，你可以有一個計數器（即眉頭）來跟蹤你在工作表中乙看着

Dim cell as Range 
Dim bRow as Integer 
bRow = 1 
With Worksheets("A") 
    For Each cell in Range(.Range("B1"), .Range("B1").End(xlDown)) 
     If (cell.Value = Worksheets("B").Range("C" & bRow).Value0 Then 
      cell.EntireRow.Delete Shift:=xlUp 
      Worksheets("B").Range("C" & bRow).EntireRow.Delete Shift:=xlUp 
     Else 
      bRow = bRow + 1 
     End If    
    Next cell 
End WIth 

Answer 3

所以，我終於想通了這一點。這不是很好，我確信有一個更優雅的方式來做到這一點，但在這裏。

Option Explicit 

Public Sub purWIP() 

Dim wipWS As Worksheet 
Dim invWS As Worksheet 
Dim P As Range 
Dim i As Integer, x As Integer 


Set wipWS = Worksheets("Work in Process") 
Set invWS = Worksheets("Inventory Allocation") 



' Start by checking conditions of a certain row 
For x = wipWS.UsedRange.Rows.count To 1 Step -1 
    With wipWS 
     ' For each cell in wipWS I'm going to check whether a certain condition exists 
     For Each P In wipWS.Range(.Cells(6, 5), .Cells(wipWS.Rows.count, 5).End(xlUp)) 
      'If it does, then I'm going to check the Inventory Allocation Worksheet to see if there's a match 
      If (IsDate(P.Offset(0, 7))) Then 
       invWS.Activate 
       ' I do a for loop here and add 1 to i (this was the part that fixed it) 
       For i = invWS.UsedRange.Rows.count + 1 To 3 Step -1 
        If invWS.Cells(i, "B") = P.Offset(0, 0) Then 
         invWS.Rows(i).EntireRow.Delete Shift:=xlUp 
        End If 
       Next 
       P.EntireRow.Delete Shift:=xlUp 
      End If 
     Next 
    End With 
Next 
wipWS.Activate 

末次