Question

我尝试了很多代码变体，这让我最接近。我有2个工作表; worksheet1具有总数据，worksheet2具有一个范围，用于标识sheet1中需要保留的行，因此应删除该范围内未找到的任何值。当我运行代码时，删除的内容并没有匹配，并且在一个小测试中它没有删除任何值。我做错了什么？

Sub Delete()
    Dim nRng As Range, rng As Range
    Set nRng = Range("Dog") 'Substitute actual name of range
    Set rng = Range("A1", ActiveSheet.Cells(Rows.Count, "A").End(xlUp)) 
    For Each c In rng 'Look at each item in col K
        If WorksheetFunction.CountIf(nRng, c.Value) = 0 Then 'Evaluate against named range
        c.EntireRow.Delete 'Delete rows with no match to named range
    End If
    Next   
End Sub

Answer 1

如果要删除它们，则需要向后迭代集合中的Range Object或任何对象原因是如果删除该对象的实例，VBA会保留或记住其位置（删除时不会更新），从而跳过实际的下一个对象。

<强>插图：

enter image description here

因此，在上图中，C4已经取消C3的位置，因为它已被删除。
但VBA将继续检查位置4，因为它已经通过了位置3 要通过Range正确迭代和删除，请执行以下操作：

For i = Rng.Count To 1 Step -1
    If WorksheetFunction.CountIf(nRng, Rng(i)) = 0 Then
        Rng(i).EntireRow.Delete
    End If
Next

结果将是：

enter image description here

编辑1：代码重构建议或解决方法

如果您正在使用命名范围，请明确说明。

Dim nRng As Range, rng As Range, i As Long
Dim ws As Worksheet: Set ws = ActiveSheet
Set nRng = ThisWorkbook.Names("mylist").RefersToRange ' mylist is a named range

With ws ' explicit referencing objects
    Set rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

' use of expression.Rows.Count and Range.Range to handle any range size
For i = rng.Rows.Count To 1 Step -1
    If IsError(Application.Match(rng.Range("A" & _
    i).Value, nRng, 0)) Then rng.Range("A" & i).EntireRow.Delete
Next

或者更好的方法是首先获取所有删除值并一次删除。这消除了上述迭代方向（向前或向后）的问题。

Dim nRng As Range, rng As Range, c As Range
Dim ws As Worksheet: Set ws = ActiveSheet
Set nRng = ThisWorkbook.Names("mylist").RefersToRange

With ws
    Set rng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
End With

Dim rngToDelete As Range
For Each c In rng
    If IsError(Application.Match(c.Value, _
    nRng, 0)) Then
        ' collect all the ranges for deletion first
        If rngToDelete Is Nothing Then
            Set rngToDelete = c
        Else
            Set rngToDelete = Union(rngToDelete, c)
        End If
    End If
Next
' delete in one go
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete xlUp

对我而言，第二种方法是最佳解决方案。我个人在所有需要删除范围的代码中使用该方法。如果上面没有任何内容适合您，也可以发布我们可以处理的示例数据来模拟您的问题。

Answer 2

我发现以下代码适用于多个测试

Sub DeleteRows()
    'Deletes rows where one cell does not meet criteria
    Dim ws1 As Worksheet: Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Dim ws2 As Worksheet: Set ws2 = ActiveWorkbook.Sheets("Sheet2")
    Dim lr As Long
    Dim i As Long
    lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
        For i = lr To 1 Step -1
            If Application.CountIf(ws2.Range("A:A"), ws1.Cells(i, 1).Value) = 0 Then
                ws1.Cells(i, 1).EntireRow.Delete
            End If
        Next i
    Application.ScreenUpdating = True
    End Sub

如果未在范围内找到，请删除行

2 个答案: