[已解决]请问如何比较两列数据

zxc1152468

现在我有两列数据都是姓名，需要比较，第一列和第二列中姓名有不相同的就显示在第三列，另外第列姓名和第二列姓名的顺序是乱的

最佳答案

月排行榜 / 总排行榜

fffox

2015-1-25 21:20

两列姓名，所有没有重复的姓名显示在第三列：

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim d As Object
   
5.     Dim arr, brr, crr()
   
6.     Dim dKeys, dItems
   
7.     Dim i&, k&
   
8.    
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.    
    
11.     With Sheet1
    
12.         arr = .Range("a1:a" & .Cells(Rows.Count, 1).End(3).Row)
    
13.         brr = .Range("b1:b" & .Cells(Rows.Count, 2).End(3).Row)
    
14.     End With
    
15.    
    
16.     cf d, arr
    
17.     cf d, brr
    
18.    
    
19.     dKeys = d.keys
    
20.     dItems = d.items
    
21.     ReDim crr(1 To d.Count, 1 To 1)
    
22.    
    
23.     For i = 1 To d.Count
    
24.         If dItems(i - 1) = 1 Then
    
25.             k = k + 1
    
26.             crr(k, 1) = dKeys(i - 1)
    
27.         End If
    
28.     Next
    
29.    
    
30.     Sheet1.Range("c1").Resize(k) = crr
    
31.    
    
32. End Sub
    
33. 
    
34. Sub cf(dic As Object, ByVal ar)
    
35.     Dim i&
    
36.     For i = 1 To UBound(ar)
    
37.         If dic.exists(ar(i, 1)) Then
    
38.             dic(ar(i, 1)) = 2
    
39.         Else
    
40.             dic(ar(i, 1)) = 1
    
41.         End If
    
42.     Next
    
43. End Sub

复制代码

跳转到最佳答案楼层

baksy

请上传附件。

fffox

两列姓名，所有没有重复的姓名显示在第三列：

1. Option Explicit
   
2. 
   
3. Sub test()
   
4.     Dim d As Object
   
5.     Dim arr, brr, crr()
   
6.     Dim dKeys, dItems
   
7.     Dim i&, k&
   
8.    
   
9.     Set d = CreateObject("scripting.dictionary")
   
10.    
    
11.     With Sheet1
    
12.         arr = .Range("a1:a" & .Cells(Rows.Count, 1).End(3).Row)
    
13.         brr = .Range("b1:b" & .Cells(Rows.Count, 2).End(3).Row)
    
14.     End With
    
15.    
    
16.     cf d, arr
    
17.     cf d, brr
    
18.    
    
19.     dKeys = d.keys
    
20.     dItems = d.items
    
21.     ReDim crr(1 To d.Count, 1 To 1)
    
22.    
    
23.     For i = 1 To d.Count
    
24.         If dItems(i - 1) = 1 Then
    
25.             k = k + 1
    
26.             crr(k, 1) = dKeys(i - 1)
    
27.         End If
    
28.     Next
    
29.    
    
30.     Sheet1.Range("c1").Resize(k) = crr
    
31.    
    
32. End Sub
    
33. 
    
34. Sub cf(dic As Object, ByVal ar)
    
35.     Dim i&
    
36.     For i = 1 To UBound(ar)
    
37.         If dic.exists(ar(i, 1)) Then
    
38.             dic(ar(i, 1)) = 2
    
39.         Else
    
40.             dic(ar(i, 1)) = 1
    
41.         End If
    
42.     Next
    
43. End Sub

复制代码