原数据和现数据相比对，把相同的找出来，把不同的找出来

szxwhysl

用原数据ＡＢＣ列与现数据ＥＦＧ列相比，把原数中有不同的找出来，把现数据中有不同的找出来，把都有的也找出来，谢谢，大佬们

songshihai

1. Sub 提取异同()
   
2.     Dim a1, a2, arr1, arr2
   
3.     Set 一独有 = CreateObject("scripting.dictionary")
   
4.     Set 二独有 = CreateObject("scripting.dictionary")
   
5.     Set 都有 = CreateObject("scripting.dictionary")
   
6.     数据1 = Range("a1").CurrentRegion
   
7.     数据2 = Range("e1").CurrentRegion
   
8.     For i = 3 To UBound(数据1)
   
9.         a1 = 数据1(i, 1) & 数据1(i, 2) & 数据1(i, 3)
   
10.         For j = 3 To UBound(数据2)
    
11.             a2 = 数据2(j, 1) & 数据2(j, 2) & 数据2(j, 3)
    
12.             If a1 = a2 Then 都有(a1) = Array(数据1(i, 1), 数据1(i, 2), 数据1(i, 3)): GoTo 100
    
13.         Next j
    
14.         一独有(a1) = Array(数据1(i, 1), 数据1(i, 2), 数据1(i, 3))
    
15. 100:
    
16.     Next i
    
17.     For j = 3 To UBound(数据2)
    
18.         a2 = 数据2(j, 1) & 数据2(j, 2) & 数据2(j, 3)
    
19.         For i = 3 To UBound(数据1)
    
20.             a1 = 数据1(i, 1) & 数据1(i, 2) & 数据1(i, 3)
    
21.             If a2 = a1 Then GoTo 200
    
22.         Next i
    
23.         二独有(a2) = Array(数据2(j, 1), 数据2(j, 2), 数据2(j, 3))
    
24. 200:
    
25.     Next j
    
26.     If 一独有.Count > 0 Then
    
27.         [i6].Resize(一独有.Count, 3) = Application.Transpose(Application.Transpose(一独有.items))
    
28.     Else
    
29.         [i6] = "无"
    
30.     End If
    
31.     If 二独有.Count > 0 Then
    
32.         [m6].Resize(二独有.Count, 3) = Application.Transpose(Application.Transpose(二独有.items))
    
33.     Else
    
34.         [m6] = "无"
    
35.     End If
    
36.     If 都有.Count > 0 Then
    
37.         [q6].Resize(都有.Count, 3) = Application.Transpose(Application.Transpose(都有.items))
    
38.     Else
    
39.         [q6] = "无"
    
40.     End If
    
41. End Sub
    

复制代码

ynzsvt

1. Sub 提取异同ynzsvt()
   
2. Dim a1$, Arr1, 一独有, 二独有, 都有, 数据1, 数据2, i&
   
3. Set 一独有 = CreateObject("scripting.dictionary")
   
4. Set 二独有 = CreateObject("scripting.dictionary")
   
5. Set 都有 = CreateObject("scripting.dictionary")
   
6. 数据1 = Range("a1").CurrentRegion
   
7. 数据2 = Range("e1").CurrentRegion
   
8. For i = 3 To UBound(数据1)
   
9.   Arr1 = Array(数据1(i, 1), 数据1(i, 2), 数据1(i, 3))
   
10.   a1 = Join(Arr1, "|")
    
11.   一独有(a1) = Arr1
    
12. Next i
    
13. 
    
14. For i = 3 To UBound(数据2)
    
15.   Arr1 = Array(数据2(i, 1), 数据2(i, 2), 数据2(i, 3))
    
16.   a1 = Join(Arr1, "|")
    
17.   If 一独有.Exists(a1) Then
    
18.    一独有.Remove (a1): 都有(a1) = Arr1
    
19.   Else
    
20.    二独有(a1) = Arr1
    
21.   End If
    
22. Next i
    
23. 
    
24. '输出
    
25. If 一独有.Count > 0 Then
    
26.   [i6].Resize(一独有.Count, 3) = Application.Rept(一独有.Items, 1)
    
27. Else
    
28.   [i6] = "无"
    
29. End If
    
30. If 二独有.Count > 0 Then
    
31.   [m6].Resize(二独有.Count, 3) = Application.Rept(二独有.Items, 1)
    
32. Else
    
33.   [m6] = "无"
    
34. End If
    
35. If 都有.Count > 0 Then
    
36.   [q6].Resize(都有.Count, 3) = Application.Rept(都有.Items, 1)
    
37. Else
    
38.   [q6] = "无"
    
39. End If
    
40. End Sub

复制代码