保哥笔记

下面这段宏代码，运行后会弹出对话框，然后输入内容，即可批量删除内容所在的行。

Sub 删除特定字符所在行()
    Dim rng As Range
    'On Error Resume Next
    istr = InputBox("请输入需要查找的字符:", "查找")
    If istr = "" Then Exit Sub
    arr = Split(istr, "、")
    With ActiveSheet
        For j = 0 To UBound(arr)
            For i = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
                Set icol = .Rows(i).Find(arr(j), LookAt:=xlPart)
                If Not icol Is Nothing Then
                    k = k + 1
                    If rng Is Nothing Then
                        Set rng = .Rows(i)
                    Else
                        Set rng = Union(rng, .Rows(i))
                    End If
                End If
            Next i
        Next j
        If k = 0 Then
            MsgBox "没有发现含有" & istr & "的行."
        ElseIf MsgBox("共发现了" & k & "个含有" & istr & "的行,是否删除这些行?", vbYesNo) = vbYes Then
            rng.Delete
        End If
    End With
End Sub

另一段宏代码是反向删除行，填入要保留的字符，运行后可将字符所在行以为的行批量删除：

Sub 删除特定字符所在行以外的行()
    Dim rng As Range
    istr = InputBox("请输入需要查找的字符:", "查找")
    If istr = "" Then Exit Sub
    arr = Split(istr, "、")
    With ActiveSheet
            For i = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
                k = 0
                For j = 0 To UBound(arr)
                    Set icol = .Rows(i).Find(arr(j), LookAt:=xlPart)
                    If Not icol Is Nothing Then k = k + 1
                Next j
                If k = 0 Then
                    If rng Is Nothing Then
                        Set rng = .Rows(i)
                    Else
                        Set rng = Union(rng, .Rows(i))
                    End If
                End If
            Next i
        If MsgBox("是否保留含有" & istr & "的行,删除其它行?", vbYesNo) = vbYes Then
            rng.Delete
        End If
    End With
End Sub