[已解决]如何对两列中的文本的特定字符串进行查找、对比？

lovecfjack

比如B列某行的文本为：

apple[yes]apple

而C列的文本为：

苹果[yes]苹果

如何能过函数或VBA检查B列内[]字符串中的内容到了C列是否有增加、减少、或改动？[]中的内容不是固定的文本，有文本，也有数字。

最佳答案

月排行榜 / 总排行榜

grf1973

2017-1-22 13:19

1. Sub tt()
   
2.     arr = Range("b1:c" & [b65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     With CreateObject("vbscript.regexp")
   
7.         .Global = True
   
8.         .Pattern = "\{.+?\}"
   
9.         For i = 1 To UBound(arr)
   
10.             x = arr(i, 1): y = arr(i, 2)
    
11.             For Each m In .Execute(x)
    
12.                 d(m.Value) = d(m.Value) + 1
    
13.             Next
    
14.             For Each m In .Execute(y)
    
15.                 d1(m.Value) = d1(m.Value) + 1
    
16.             Next
    
17.         
    
18.             For Each m In d.keys
    
19.                 If d(m) <> d1(m) Then s = m & "在B列出现" & d(m) & "次，在C列出现" & Val(d1(m)) & "次"
    
20.             Next
    
21.             brr(i, 1) = IIf(Len(s), s, "ok")
    
22.             d1.RemoveAll: d.RemoveAll: s = ""
    
23.         Next
    
24.     End With
    
25.     [e1].Resize(UBound(arr)) = brr
    
26. End Sub

复制代码

跳转到最佳答案楼层

望帝春心

提问请上传EXCEL压缩文件，模拟特征数据，并给出想要的结果

grf1973

1. Sub tt()
   
2.     arr = Range("b1:c" & [b65536].End(3).Row)
   
3.     ReDim brr(1 To UBound(arr), 1 To 1)
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     With CreateObject("vbscript.regexp")
   
7.         .Global = True
   
8.         .Pattern = "\{.+?\}"
   
9.         For i = 1 To UBound(arr)
   
10.             x = arr(i, 1): y = arr(i, 2)
    
11.             For Each m In .Execute(x)
    
12.                 d(m.Value) = d(m.Value) + 1
    
13.             Next
    
14.             For Each m In .Execute(y)
    
15.                 d1(m.Value) = d1(m.Value) + 1
    
16.             Next
    
17.         
    
18.             For Each m In d.keys
    
19.                 If d(m) <> d1(m) Then s = m & "在B列出现" & d(m) & "次，在C列出现" & Val(d1(m)) & "次"
    
20.             Next
    
21.             brr(i, 1) = IIf(Len(s), s, "ok")
    
22.             d1.RemoveAll: d.RemoveAll: s = ""
    
23.         Next
    
24.     End With
    
25.     [e1].Resize(UBound(arr)) = brr
    
26. End Sub

复制代码

lovecfjack

谢谢楼上的朋友，但是还有一点小缺陷，就是如果多个字符串中的内容都不一样时，这个宏只会显示一个字符串的数量不同。

grf1973

嗯，忘了字符串累加了。

lovecfjack

完美了，太谢谢了。