Excel 使用VBA删除具有特定条件的行

我在另一篇文章中发现了这段代码，它会挑出一行，但它会删除除指定行之外的所有其他行

我处理大量的地址列表，我需要一些我可以运行的东西来识别和删除带有我们被要求不发送邮件的地址的行。我刚刚发现了一些VBA，我非常绿色。但我希望有一个模块，允许我在列表增长时添加多个地址

Sub DeleteRows()

   Dim i as long, LastRow As long
   with activesheet
       LastRow = .Cells(.Rows.Count, 1).End(xlUp).row

       For i =  LastRow to 2 step -1

           If .Cells(i, 1).Value <> "certain value" Then

              .Rows(i).Delete

           End If

       Next i
   End With
End Sub

只需改变这一点：

如果.Cellsi，1.值一定值，则-其中单元格值不同于一定值

Sub DeleteRows()

    Dim i As Long, LastRow As Long

    With ActiveSheet
        LastRow = .Cells(.Rows.count, 1).End(xlUp).row

        For i = LastRow To 2 Step -1
            If .Cells(i, 1).value = "certain value" Then
                .Rows(i).Delete
            End If
        Next i
    End With

End Sub

为此：

如果.Cellsi，1.Value=某个值，则-其中单元格值等于某个值

Sub DeleteRows()

    Dim i As Long, LastRow As Long

    With ActiveSheet
        LastRow = .Cells(.Rows.count, 1).End(xlUp).row

        For i = LastRow To 2 Step -1
            If .Cells(i, 1).value = "certain value" Then
                .Rows(i).Delete
            End If
        Next i
    End With

End Sub

---

可以使用Union一次性收集符合条件的行并删除。另外，还有一个单独的表，用于存储要匹配的地址。将这些地址读入数组，然后循环要从中删除数据的工作表，并检查是否在数组中找到给定地址。如果找到，请使用Union存储该单元格，以便以后删除。 在循环要检查的数据结束时，一次性删除与union的range对象中存储的单元格关联的行

Option Explicit
Public Sub DeleteThemRows()
    Dim arr(), unionRng As Range, i As Long, lastRow As Long, rng As Range
    Dim wsAddress As Worksheet, wsDelete As Worksheet

    Set wsAddress = ThisWorkbook.Worksheets("Addresses")
    Set wsDelete = ThisWorkbook.Worksheets("DataToDelete")

    With wsAddress                               '<= Assume addresses stored in column A starting from cell A1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Select Case lastRow
        Case 1
            ReDim arr(1, 1): arr(1, 1) = .Range("A1").Value
        Case Is >= 2
            arr = .Range("A1:A" & lastRow).Value
        End Select
        arr = Application.WorksheetFunction.Index(arr, 0, 1)
    End With

    With wsDelete  '<==Assume address column to check is column A

        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim loopRange As Range
        Set loopRange = .Range("A1:A" & lastRow)
        If Application.WorksheetFunction.CountA(loopRange) = 0 Then Exit Sub

        For Each rng In loopRange.SpecialCells(xlCellTypeConstants)
            If Not IsError(Application.Match(rng.Value, arr, 0)) Then
                If Not unionRng Is Nothing Then
                    Set unionRng = Union(unionRng, rng)
                Else
                    Set unionRng = rng
                End If
            End If
        Next
    End With
    If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
End Sub

您可以先使用Debug.Print unionRng.Address检查要删除的内容

Sub FastDelete()

    Dim rng As Range, rngData As Range, rngVisible As Range
    Const CRITERIA$ = "SOME_VALUE"

    Set rng = Range("A1").CurrentRegion '//Whole table
    With rng '//Table without header
        Set rngData = .Offset(1).Resize(.Rows.Count - 1)
    End With

    '// Filter by column "A"
    rng.AutoFilter Field:=1, Criteria1:=CRITERIA
    On Error Resume Next '//In case if no values filtered
    Set rngVisible = rng.SpecialCells(xlCellTypeVisible)
    If Err = 0 Then
        rngVisible.EntireColumn.Delete
    End If
    On Error GoTo 0

End Sub