如果在范围内找不到，则删除行
我已经尝试了许多代码的变体，这使我最接近。我有2个工作表; worksheet1有全部的数据，worksheet2有一个范围，用于识别sheet1中的行需要被保留，所以在该范围内找不到的值应该被删除。 当我运行代码时，被删除的内容不匹配，在一个小testing中，它并没有删除任何值。 我做错了什么？
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 如果要删除它们，则需要向后迭代Range Object或集合中的任何对象。
原因是，如果您删除该对象的实例，VBA将保留或记住其位置（不会在删除时更新），从而跳过实际的下一个对象。
插图：
所以在上面的例子中， 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
结果将是：
编辑1：代码重构build议或解决方法
-
如果你正在使用一个命名的范围，明确表示它。
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
对我来说，第二种方法是最好的解决scheme。 我个人在所有需要删除范围的代码中都使用这种方法。 如果上面没有任何内容适合您，那么不妨发布一个示例数据，我们可以开始模拟您的问题。
我发现下面的代码在多个testing中工作
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