刪除所有包含值VBA的行

Question

我從事這項工作的時間比我想承認的要長。 我正在比較兩個工作表（A和B）。 我遍歷A-Column（“ B”），並針對該列中的每個值對照B-Column（“ 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

您正在比較兩個工作表（A和B）。 您要遍歷A-Column（“ B”），並針對該列中的每個值，對照B-Column（“ C”）檢查。 因此，您可以有一個計數器（即bRow）來跟蹤工作表B中正在查看的行

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 2

無需運行2個循環，您可以在工作表（“正在處理”）中運行1個For循環，掃描列B，然后僅使用Match函數在整個C范圍內搜索該值-設置為Worksheets （“庫存分配”）位於列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 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

結束子