Question

我正在尝试创建一个过滤器来删除不包含任何一个指定文本的行。有三种情况，我在撰写最后一篇文章时遇到了一些困难（第3点）。（Excel版本：2010）

1. IF单元格值=文本然后下一行[完成]
2.IF单元值＆lt;＆gt;文本那么下一篇文章[完整]
3.IF单元值＆lt;＆gt;任何文本然后删除行[不知道如何写这个]

Sub Filter()

Dim i As Integer
Dim word(1 To 20) As String
Dim iRow As Integer, iCol As Integer

word(1) = "AA"
word(2) = "BB"
word(3) = "CC"
word(4) = "DD"
word(5) = "EE"
word(6) = "FF"
word(7) = "GG"
word(8) = "HH"
word(9) = "XXX"

iCol = ActiveCell.Column

For iRow = ActiveCell.End(xlDown).Row To 1 Step -1

    For i = 1 To UBound(word)
        If Cells(iRow, iCol).Value = word(i) Then
        GoTo NextRow
        Else
        GoTo Nextword
        End If
Nextword:
    Next i

NextRow:
    Next iRow

End Sub

Answer 1

只需保留Boolean变量，说明您是否匹配任何字词：

Sub Filter()

    Dim i As Integer
    Dim word(1 To 20) As String
    Dim iRow As Integer, iCol As Integer
    Dim Matched As Boolean

    word(1) = "AA"
    word(2) = "BB"
    word(3) = "CC"
    word(4) = "DD"
    word(5) = "EE"
    word(6) = "FF"
    word(7) = "GG"
    word(8) = "HH"
    word(9) = "XXX"

    iCol = ActiveCell.Column

    For iRow = ActiveCell.End(xlDown).Row To 1 Step -1
        Matched = False
        For i = 1 To UBound(word) ' Note: This is 1 To 20, not 1 To 9
                                  '       positions 10 To 20 still exist even though
                                  '       they have not been assigned a value
            If Cells(iRow, iCol).Value = word(i) Then
                Matched = True
                Exit For
            End If
        Next i
        If Not Matched Then
            Rows(iRow).Delete
        End If
    Next iRow

End Sub

Answer 2

要小心依赖ActiveCell，这可能不是您所期望的：您可以更好地参考您必须从中开始的范围

无论如何，假设您的ActiveCell是列的标题，其下方有数据，您可以使用AutoFilter()并排序＆＃34;反向＆＃34;过滤后的细胞

Option Explicit

Sub Filter()
    Dim dataToKeep As Range
    Dim iArea As Long
    Dim words As Variant

    words = Array("AA", "BB", "CC", "DD", "EE", "FF", "GG", "HH", "XXX")

    With Range(ActiveCell, ActiveCell.End(xlDown))
        .AutoFilter Field:=1, Criteria1:=words, Operator:=xlFilterValues
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then
            Set dataToKeep = .SpecialCells(xlCellTypeVisible)
        Else
            .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        End If
        .Parent.AutoFilterMode = False
    End With
    If Not dataToKeep Is Nothing Then
        With dataToKeep.Areas
            If Intersect(.Item(.Count), ActiveCell.End(xlDown)) Is Nothing Then .Parent.Parent.Range(.Item(.Count).Cells(.Item(.Count).Rows.Count, 1).Offset(1), ActiveCell.End(xlDown)).EntireRow.Delete
            For iArea = .Count To 2 Step -1
                .Parent.Parent.Range(.Item(iArea).Cells(1, 1).Offset(-1), .Item(iArea - 1).Cells(.Item(iArea - 1).Rows.Count, 1).Offset(1)).EntireRow.Delete
            Next
        End With
    End If
End Sub

如何编写一个宏来删除没有特定文本的行

2 个答案: