多个关键词批量删除

zhengchen007

包含 表2 A列的词，表1 全部自动剔除除，【表2 A列后期可能还会添加更多关键词】表1 的关键词可能还有重复，最好能再去重后输出到 表3 A列示例文件在附件里
求高手帮忙指点下如何实现，小弟感激不尽！

w609053988

数组+字典去重再去重

zhengchen007

w609053988 发表于 2019-8-22 13:15
数组+字典去重再去重

这个具体怎么做能帮忙详细写一下吗？  以前都是人肉去除工作量很大而且比较重复。大神会的话拯救一下。

w609053988

1. Sub test()
   
2. 
   
3.     Dim arr(), brr(), i&, d As Object
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     arr = Sheet1.Range("a1").CurrentRegion.Value
   
6.     brr = Sheet2.Range("a1").CurrentRegion.Value
   
7.    
   
8.     For i = 1 To UBound(arr)
   
9.         d(arr(i, 1)) = ""
   
10.     Next
    
11. 
    
12.     For i = 1 To UBound(brr)
    
13.         If d.Exists(brr(i, 1)) Then d.Remove (brr(i, 1))
    
14.     Next
    
15.    
    
16.     Sheet3.Range("a:a").ClearContents
    
17.     Sheet3.Range("a1").Resize(d.Count) = Application.Transpose(d.Keys)
    
18. End Sub

复制代码

zhengchen007

w609053988 发表于 2019-8-22 13:23

谢谢您的解答，但是vba没接触过  我新建运行后是这个弹窗

w609053988

zhengchen007 发表于 2019-8-22 13:31
谢谢您的解答，但是vba没接触过  我新建运行后是这个弹窗

把那些问号??都删掉,Ctrl+H,替换成空吧

zhengchen007

w609053988 发表于 2019-8-22 13:41
把那些问号??都删掉,Ctrl+H,替换成空吧

谢谢，vba可以运行了，但是输出到表3的内容并没有去掉表2里包含的关键词

w609053988

zhengchen007 发表于 2019-8-22 13:58
谢谢，vba可以运行了，但是输出到表3的内容并没有去掉表2里包含的关键词

你再检查检查，代码有剔除Sheet2的关键词的

2E-er

！！！！！！！！！！！！！！！！！！！！！！！

zopey

1. Sub pey_test()
   
2.     Dim arr(), d As Object
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.    
   
5.     arr = Sheet1.Range("a1").CurrentRegion.Value
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1)) = d(arr(i, 1)) + 1
   
8.     Next
   
9.     '''''''''''
   
10.     Dim brr, k0
    
11.     With Sheet2
    
12.          k0 = .[a65535].End(3).Row
    
13.          brr = .[a1].Resize(k0, 1)
    
14.     End With
    
15.    
    
16.     '''''''''''''''
    
17.     For i = 1 To k0
    
18.     temp = Trim(brr(i, 1))
    
19.     If Len(temp) > 0 Then
    
20.         For Each ma In d.keys
    
21.             If InStr(ma, arr(i, 1)) Then d.Remove (ma): Exit For
    
22.         Next
    
23.     End If
    
24.     Next i
    
25.    
    
26.     Sheet3.Range("a:a").ClearContents
    
27.     Sheet3.Range("a1").Resize(d.Count) = Application.Transpose(d.keys)
    
28. End Sub

复制代码

略作修改