Home >  > 关键词过滤工具

关键词过滤工具

0

项目需求:
sheet1是我们采集到的关键字,
Snap18566

sheet2是要过滤的关键词列表,即只要sheet1的关键词中包含了sheet2的关键词,则删除sheet1表中的关键词。
例如:sheet2中有个关键词“车”,sheet1表中有个关键词“北斗服务车”,则删除sheet1中的“北斗服务车”。

Snap185654

右击sheet1的标签页,在出现的菜单中选择“view code”,然后输入代码:

Snap185655

代码如下:

Sub keywordsfilter()
For i = 2 To Sheets(2).Range("a65536").End(xlUp).Row
Sheets(1).Select
With Range("a2:a65536")
    Set c = .Find(Sheets(2).Cells(i, 1), LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            Cells(c.Row, 1).Delete shift:=xlUp
            Set c = .FindNext()
        Loop While Not c Is Nothing
    End If
End With
Next
MsgBox "over"
End Sub

然后通过“Tools - Macro”菜单就可以使用这个Macro了。

不过推荐另一个代码,执行几千上万行的时候会快一点,而且有删除多少关键字的提示信息。

Sub QQDelData()
Dim i&, j&, Jm&, Arr, Brr, Crr, TM
TM = Timer
Arr = Range([sheet1!A1], [sheet1!A65536].End(xlUp))
Brr = Range([sheet2!A1], [sheet2!A65536].End(xlUp))
ReDim Crr(1 To UBound(Arr), 0)
For i = 1 To UBound(Arr)
    If Arr(i, 1) = "" Then GoTo 101
For j = 1 To UBound(Brr)
    If InStr(" " & Arr(i, 1), Brr(j, 1)) > 1 Then GoTo 101
Next j
    Jm = Jm + 1: Crr(Jm, 0) = Arr(i, 1)
101: Next i
[sheet1!A1:A65536].ClearContents
[sheet1!A1].Resize(Jm) = Crr
MsgBox "共刪除 " & UBound(Arr) - Jm & " 行,使用 " & Timer - TM & " 秒  "
End Sub

执行完的提示:
Snap185656

原载:蜗牛博客
网址:http://www.snailtoday.com
尊重版权,转载时务必以链接形式注明作者和原始出处及本声明。

本文暂无标签

发表评论

*

*