查询删除包含某些关键词的行

异面平行线

关键词表在sheet2 A列（关键词有几百个（行））
依次在sheet1 A列查找 sheet2 A列关键词表，如果关键词在sheet1某单元格存在
则删除该单元格所在行

3190496160

Sub 删除行()
Dim d As Object
Dim ar As Variant, br As Variant
Dim rng As Range
Set d = CreateObject("scripting.dictionary")
With Sheets("关键字")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:a" & r)
End With
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = ""
    End If
Next i
For Each k In d.keys
    With Sheets("汇总")
        rs = .Cells(Rows.Count, 2).End(xlUp).Row
        br = .Range("b1:b" & rs)
        For i = 2 To UBound(br)
            If Trim(br(i, 1)) <> "" Then
                If InStr(br(i, 1), k) > 0 Then
                    m = m + 1
                    If rng Is Nothing Then
                        Set rng = .Rows(i)
                    Else
                        Set rng = Union(rng, .Rows(i))
                    End If
                End If
            End If
        Next i
    End With
Next k
If Not rng Is Nothing Then
    rng.Delete
    MsgBox "删除了" & m & "行数据"
End If
End Sub

3190496160

关键字删除整行.rar (34.7 KB, 下载次数: 1)

2020-10-18 10:13 上传

点击文件名下载附件

3190496160

结果未认真核对，自己核对看看