单元格文本差异比较(BOM位号差异)-[已解决]

northwolves

1. 
   
2. Function Ref_diff(str1, str2 As String) As String
   
3. Dim r As Range, dic As Object, arr1, arr2
   
4. Set dic = CreateObject("scripting.dictionary")
   
5. On Error Resume Next
   
6. arr1 = Split(str1, ",")
   
7. arr2 = Split(str2, ",")
   
8. For i = 0 To UBound(arr1)
   
9. dic(arr1(i) & "$") = arr1(i)
   
10. Next
    
11. For i = 0 To UBound(arr2)
    
12. If dic.exists(arr2(i) & "$") Then
    
13. dic(arr2(i) & "$") = arr2(i) & "$"
    
14. Else
    
15. dic(arr2(i)) = arr2(i) & "$"
    
16. End If
    
17. Next
    
18. arr1 = Join(Filter(dic.keys, "$", False), ",")
    
19. arr2 = Join(Filter(dic.items, "$", False), ",")
    
20. If arr1 <> "" Then Ref_diff = "Add " & arr1
    
21. If arr2 <> "" Then Ref_diff = Ref_diff & "   Del " & arr2
    
22. Ref_diff = Replace(Trim(Ref_diff), "  ", ";")
    
23. Set dic = Nothing
    
24. End Function
    
25. 
    

复制代码

myj_su

Book1.rar (14.54 KB, 下载次数: 48)

2009-6-6 01:26 上传

点击文件名下载附件

多谢狼版, 这样的方案会导致无法识别缩写
如C2:C6, 这也是当初狼版选择Range对象的目的哦
如附件 黄色部分
版主费心了,请再 看看有没有两全的方案

northwolves

稍加修改即可

1. 
   
2. Function Ref_diff(str1, str2 As String) As String
   
3.     Dim r As Range, dic As Object, arr1, arr2
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     On Error Resume Next
   
6.     arr1 = Split(str1, ",")
   
7.     arr2 = Split(str2, ",")
   
8.     For i = 0 To UBound(arr1)
   
9.         If arr1(i) Like "*:*" Then
   
10.             For Each r In Range(arr1(i))
    
11.                 dic(r.Address(0, 1)) = r.Address(0, 0)
    
12.             Next
    
13.         Else
    
14.             dic("$" & arr1(i)) = arr1(i)
    
15.         End If
    
16.     Next
    
17. 
    
18.     For i = 0 To UBound(arr2)
    
19.         If arr2(i) Like "*:*" Then
    
20.             For Each r In Range(arr2(i))
    
21.                 If dic.exists(r.Address(1, 0)) Then
    
22.                     dic(r.Address(0, 1)) = r.Address(0, 1)
    
23.                 Else
    
24.                     dic(r.Address(0, 0)) = r.Address
    
25.                 End If
    
26.             Next
    
27.         Else
    
28.             If dic.exists("$" & arr2(i)) Then
    
29.                 dic("$" & arr2(i)) = "$" & arr2(i)
    
30.             Else
    
31.                 dic(arr2(i)) = "$" & arr2(i)
    
32.             End If
    
33.         End If
    
34.     Next
    
35.     arr1 = Join(Filter(dic.keys, "$", False), ",")
    
36.     arr2 = Join(Filter(dic.items, "$", False), ",")
    
37.     If arr1 <> "" Then Ref_diff = "Add " & arr1
    
38.     If arr2 <> "" Then Ref_diff = Ref_diff & "   Del " & arr2
    
39.     Ref_diff = Replace(Trim(Ref_diff), "  ", ";")
    
40.     Set dic = Nothing
    
41. End Function
    

复制代码

myj_su

多谢版主
If dic.exists(r.Address(1, 0)) Then
是否应为:If dic.exists(r.Address(0, 1)) Then
另外 使用split 分散字符串的时候,有时会遗失最后一位,我尝试加上","后解决
版主的贴子帮助很大,再次感谢了

10seconds

正好也需要这个功能，下载下来看看

duchengli

正好也需要这个功能，下载下来看看，谢谢两位好心人

lsm4234

谁有，发份给我

lsm4234

zhaogang1960 发表于 2009-5-2 00:45
请测试:
Sub Macro1()
    Dim arr, brr(1 To 2), a, b, d As Object, dic As Object

可以发份给我不

coby001

lsm4234 发表于 2014-11-30 13:27
可以发份给我不

代码都贴出来了，还要别人发给你~
自己复制一下就那么难~~

kimi404

正好也需要这个功能，下载下来看看，谢谢两位好心人