字典法求2组数据不相同的数据

hefuqing

字典法求2组数据不相同的数据

类目		类目		提取不相同数据
A		B		A
B		C		D
C				E
D				F
E
F

iwangyi

Sub DD()
Set D = CreateObject("SCRIPTING.DICTIONARY")
ARR = [c2:c3]
BRR = [a2:a7]
For i = 1 To UBound(ARR)
D(ARR(i, 1)) = ""
Next
For J = 1 To UBound(BRR)
If Not D.exists(BRR(J, 1)) Then N = N + 1: Cells(N + 1, 5) = BRR(J, 1)
Next
End Sub

iwangyi

附件参考---------------

vbee

1. 
   
2. Sub vbee()
   
3. On Error Resume Next
   
4. 
   
5. Set d = CreateObject("scripting.dictionary")
   
6.   For i = 2 To 7
   
7.   d.Add Cells(i, 1).Value, ""
   
8.   Next i
   
9.   For i = 2 To 7
   
10.   d.Remove Cells(i, 3).Value
    
11.   Next i
    
12.   
    
13.   [e2].Resize(d.Count) = Application.Rept(d.keys)
    
14.   
    
15. End Sub

复制代码

任飘渺

方法比较笨
Sub test()
    Dim dic1 As Object, dic2 As Object, arr, i As Integer, brr, crr()
    Dim n As Integer
   
    Set dic1 = CreateObject("scripting.dictionary")
    Set dic2 = CreateObject("scripting.dictionary")
    arr = [a1].CurrentRegion
    For i = 2 To UBound(arr)
        dic1(arr(i, 1)) = ""
    Next i
    brr = [c1].CurrentRegion
    For i = 2 To UBound(brr)
        dic2(brr(i, 1)) = ""
    Next i
   x = dic1.keys
   y = dic2.keys
   
    ReDim crr(0 To UBound(x) + UBound(y))
   For i = 0 To UBound(x)
       If dic2.exists(x(i)) = False Then
            crr(n) = x(i)
            n = n + 1
       End If
   Next i
   
   For i = 0 To UBound(y)
       If dic1.exists(y(i)) = False Then
            crr(n) = y(i)
            n = n + 1
       End If
   Next i
   
    Range("f2").Resize(n, 1) = Application.Transpose(crr)
   
End Sub

jiminyanyan

这个不难的。。。

microyip

4楼的方法最可取，效率高