Question

我一直在研究这个问题的时间超过了我想承认的时间。我正在比较两个工作表（A＆amp; 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＆amp; B）。您想循环通过A列（“B”）并对该列中的每个值进行检查，请检查B列（“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

您可以在工作表中运行1 For循环（＆＃34;在制品中工作＆＃34;），扫描B列，然后只使用Match函数，而不是运行2个循环在整个C范围内搜索该值 - 在C列中设置为工作表（＆＃34;库存分配＆＃34;），直到有数据的最后一行。

注意：删除行时，总是使用向后循环（向后计数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

End Sub

删除包含值VBA的所有行

3 个答案: