两列数值比较，取差异值。（有源码，需要修改）

神赐吾名丶Man.

这个是在论坛找到的，只能改成A列和B列比较或者A和C比较，我想改成B和C比较。。

改了好久都没有成功，小弟不才，希望高手帮忙。。先谢谢啦。

1. Sub test()
   
2. 
   
3.     Columns("F:F").Select
   
4.    
   
5.     Selection.ClearContents
   
6.    
   
7.     Dim arr, d As Object, i%, j%
   
8. 
   
9.     arr = [a1].CurrentRegion
   
10. 
    
11.     Set d = CreateObject("scripting.dictionary")
    
12. 
    
13.     For i = 1 To UBound(arr)
    
14. 
    
15.         d(arr(i, 1)) = ""
    
16. 
    
17.     Next i
    
18. 
    
19.     For j = 1 To UBound(arr)
    
20. 
    
21.         If d.exists(arr(j, 2)) Then
    
22. 
    
23.             d.Remove (arr(j, 2))
    
24. 
    
25.         Else
    
26. 
    
27.             d(arr(j, 2)) = ""
    
28. 
    
29.         End If
    
30. 
    
31.     Next j
    
32. 
    
33.     [f1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
34.    
    
35. End Sub

复制代码

半百

For i = 1 To UBound(arr)
        d(arr(i, 2)) = ""
    Next i
    For j = 1 To UBound(arr)
        If d.exists(arr(j, 3)) Then
            d.Remove (arr(j, 3))
        Else
            d(arr(j, 3)) = ""
        End If

    Next j

lsc900707

Sub test()
    Columns("F:F").Select
    Selection.ClearContents
    Dim arr, d As Object, i%, j%
    arr = [a1].CurrentRegion
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr)
        d(arr(i, 2)) = ""
    Next i
    For j = 1 To UBound(arr)
        If d.exists(arr(j, 3)) Then
            d.Remove (arr(j, 3))
        Else
            d(arr(j, 3)) = ""
        End If
    Next j
    [f1].Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub
  亲， 修改原代码中的数字为红色数字就好。

神赐吾名丶Man.

lsc900707 发表于 2016-7-19 12:11
Sub test()
    Columns("F:F").Select
    Selection.ClearContents

谢谢两位。。。。多谢。。

神赐吾名丶Man.

半百 发表于 2016-7-19 12:02
For i = 1 To UBound(arr)
        d(arr(i, 2)) = ""
    Next i

谢谢两位。。。。多谢。。

jiminyanyan

这题用SQL能做吗？

shaokui123

lsc900707 发表于 2016-7-19 12:11
Sub test()
    Columns("F:F").Select
    Selection.ClearContents

谢谢版主
如果只要b列比c列多的部分提取到f，怎么修改呢？

lsc900707

shaokui123 发表于 2018-9-3 09:33
谢谢版主
如果只要b列比c列多的部分提取到f，怎么修改呢？

1. Sub test()
   
2.     Columns("F:F").ClearContents
   
3.     arr = [a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 1 To UBound(arr)
   
6.         d(arr(i, 2)) = ""
   
7.     Next
   
8.     For j = 1 To UBound(arr)
   
9.         If d.exists(arr(j, 3)) Then
   
10.             d.Remove (arr(j, 3))
    
11.         End If
    
12.     Next
    
13.     [f1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
14. End Sub
    

复制代码