[已解决]根据关键字库将表中包含这些关键字的给删除

sixnu

根据关键字库将此表中包含这些关键字的给删除，我的这个程序只能点一次删除一个，不能一下子删除，如何修改呢

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-15 17:35

1. Sub Macro1()
   
2. Dim arr, brr, rng As Range, i&, k&, j%
   
3. arr = Sheet2.Range("a1").CurrentRegion
   
4. Sheet1.Activate
   
5. brr = ActiveSheet.UsedRange
   
6. For i = 1 To UBound(brr)
   
7.     For j = 1 To UBound(brr, 2)
   
8.         For k = 1 To UBound(arr)
   
9.             If brr(i, j) Like "*" & arr(k, 1) & "*" Then
   
10.                 If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
11.                 GoTo line1
    
12.             End If
    
13.         Next
    
14.     Next
    
15. line1:
    
16. Next
    
17. If Not rng Is Nothing Then rng.EntireRow.Delete
    
18. End Sub
    

复制代码

跳转到最佳答案楼层

风林火山

查找：~**~* 替换成：~* ~*

sixnu

风林火山 发表于 2014-3-15 17:00
查找：~**~* 替换成：~* ~*

很多关键字，几百个呢

dsmch

1. Sub Macro1()
   
2. Dim arr, i&
   
3. arr = Sheet2.Range("a1").CurrentRegion
   
4. Sheet1.Activate
   
5. For i = 1 To UBound(arr)
   
6.     ActiveSheet.UsedRange.Replace arr(i, 1), "", lookat:=xlPart
   
7. Next
   
8. End Sub
   

复制代码

风林火山

是sql中的吧，用这个一下就替换掉了

sixnu

dsmch 发表于 2014-3-15 17:18

我是想把关键字所在的行给删除，而不是只是删除关键字

sixnu

风林火山 发表于 2014-3-15 17:18
是sql中的吧，用这个一下就替换掉了

是EXCEL中的，想VB解决

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, rng As Range, i&, k&, j%
   
3. arr = Sheet2.Range("a1").CurrentRegion
   
4. Sheet1.Activate
   
5. brr = ActiveSheet.UsedRange
   
6. For i = 1 To UBound(brr)
   
7.     For j = 1 To UBound(brr, 2)
   
8.         For k = 1 To UBound(arr)
   
9.             If brr(i, j) Like "*" & arr(k, 1) & "*" Then
   
10.                 If rng Is Nothing Then Set rng = Cells(i, 1) Else Set rng = Union(rng, Cells(i, 1))
    
11.                 GoTo line1
    
12.             End If
    
13.         Next
    
14.     Next
    
15. line1:
    
16. Next
    
17. If Not rng Is Nothing Then rng.EntireRow.Delete
    
18. End Sub
    

复制代码

风林火山

查找替换也可以用vba，你试试

victory610

又学习了一招，非常不错呀。