两列数据内容异同VBA代码筛选为何错了

hacker85

我在F列和G列已经用函数的方法做出了正解

而后想用VBA在L列和M列再实现一下

可是一直不对，VBA代码不报错，但黄色单元格部分是不应该出现的

不知道为何。

hacker85

这是后来纠正的代码  没有用到字典  但现在我要学习一下字典了

Sub Find_Matches1() '对
Dim CompareRange As Range, x As Range, y As Range, name As Range

Set CompareRange = Range("L2:L4")
Set name = Range("M2:M4")
For Each x In name
    If Application.CountIf(CompareRange, x) = 0 Then
        x.Offset(0, 2) = x
    Else
        x.Offset(0, 3) = x
    End If
Next x
For Each y In CompareRange
    If Application.CountIf(name, y) = 0 Then y.Offset(0, 2) = y
Next y
End Sub

ccwan

你应该让一个集合中的数据和另一个中所有数据比对之后，再确定它是否独有。
一般这种问题用数组和字典比较好

[ 本帖最后由 ccwan 于 2010-1-26 14:47 编辑 ]

hacker85

恩哼，我刚刚把程序重新弄了一下，现在结果是对了

不过我不如果用字典该怎么做？

ccwan

比较通用的代码

1. Sub cc()
   
2.     Dim i&, j&, m&, n&, x&, ar1, ar2, s() As String, d As Object, dic As Object
   
3.     ar1 = Range([l1], [l65536].End(3))
   
4.     ar2 = Range([m1], [m65536].End(3))
   
5.     ReDim s(1 To UBound(ar1), 1 To 3)
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     Set dic = CreateObject("scripting.dictionary")
   
8.     For i = 1 To UBound(ar1)
   
9.         d(ar1(i, 1)) = ""
   
10.     Next
    
11.     For j = 1 To UBound(ar2)
    
12.         dic(ar2(j, 1)) = ""
    
13.         If Not d.Exists(ar2(j, 1)) Then
    
14.             m = m + 1
    
15.             s(m, 2) = ar2(j, 1)
    
16.             Else
    
17.             n = n + 1
    
18.             s(n, 3) = ar2(j, 1)
    
19.         End If
    
20.     Next
    
21.     For i = 1 To UBound(ar1)
    
22.         If Not dic.Exists(ar1(i, 1)) Then
    
23.             x = x + 1
    
24.             s(x, 1) = ar1(i, 1)
    
25.         End If
    
26.     Next
    
27.     Application.ScreenUpdating = False
    
28.     [n1:p1] = [{"L独有","M独有","LM共有"}]
    
29.     [n2].Resize(UBound(s), 3) = s
    
30.     Application.ScreenUpdating = True
    
31. End Sub

复制代码