自动搜索关键字，删除对应行

不读圣贤书

求助啊 最近公司给的任务
每天要搜几百个关键词然后删除整行数据突然想到VBA处理这些东西应该很简单，
但是我只会录制宏，
而且效果很差劲
不能批量操作

各位大佬帮我解决一下这个操作
谢谢大家

ericxzhou

1. Sub test()
   
2.     Dim i%, j%, arr
   
3.     arr = Sheet1.Range("a1:a" & Sheet1.[a65535].End(3).Row)
   
4.     For i = 1 To UBound(arr)
   
5.         Sheet2.Activate
   
6.         For j = [c65536].End(3).Row To 2 Step -1
   
7.             If InStr(1, Cells(j, 3), arr(i, 1)) Then
   
8.                 Rows(j).Delete
   
9.             End If
   
10.         Next
    
11.     Next
    
12. End Sub

复制代码

jokulboy

这是放弃SQL语句了。。。

ggmmlol

Private Sub CommandButton1_Click()
    Dim br, r0&, c&, r&, ar, i&, j&, k&, n&, flg As Boolean
    br = Sheet1.Range("A1").CurrentRegion.Resize(, 2)
    r0 = UBound(br)
    With Sheet2
        c = .Cells(1, .Columns.Count).End(xlToLeft).Column
        r = .Cells(.Rows.Count, 3).End(xlUp).Row
        ar = .Range("a1").Resize(r, c): n = 1
        For i = 2 To r
            flg = True '先假设这一行需要保留
            For k = 1 To r0
                If InStr(ar(i, 3), br(k, 1)) > 0 Then flg = False: Exit For '在C列中找到，则不保留
            Next
            If flg Then '如果最终确认该行需要保留
                n = n + 1
                For j = 1 To c
                    ar(n, j) = ar(i, j) '转录数据
                Next
            End If
        Next
        .Range("A1").Resize(r, c).ClearContents '清除原数据
        .Range("A1").Resize(n, c) = ar '写入整理后的数据
    End With
End Sub

flyfairy

这个有很多种方法,一种是查到了就删除一行,逐行操作.还有就是把符合条件的结果放入数组,然后整个重新写入.

不读圣贤书

ggmmlol 发表于 2021-7-2 13:24
Private Sub CommandButton1_Click()
    Dim br, r0&, c&, r&, ar, i&, j&, k&, n&, flg As Boolean
    ...

999999999999999999
溜翻了呦
很好用啊

感谢老大哥

不读圣贤书

ericxzhou 发表于 2021-7-2 10:12

这个好像不行 我复制进去 点了没作用  
不过楼下有个老大哥 也写了一个
可以用了
谢谢啊