给你代码，根据自己情况修改代码：
【取不重复值】：
Sub 字典比较提取不重复值()
Set dic = CreateObject("scripting.dictionary")
For i = 2 To [a300].End(3).Row
dic(Cells(i, 1).Value) = ""
Next i
For i = 2 To [b300].End(3).Row
dic.Remove (Cells(i, 2).Value)
Next i
Range("c2:c" & [c1].End(xlDown).Row).ClearContents
If [a1].End(xlDown).Row = [b1].End(xlDown).Row Then
MsgBox "两列完全对等 ！" & Chr(10) & "没有进一步比较的意义 将推出程序!"
Else
[c2].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
End If
End Sub
【取重复值】
Sub test()
Dim r%, i%
Dim arr, brr
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Worksheets("sheet1")
arr = .Range("a1").CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 50)
For i = 1 To UBound(arr)
d.RemoveAll
For j = 1 To UBound(arr, 2)
d(arr(i, j)) = d(arr(i, j)) + 1
Next
m = 0
For Each aa In d.keys
If d(aa) > 1 Then
m = m + 1
brr(i, m) = aa
End If
Next
Next
.Range("k1").Resize(UBound(brr), UBound(brr, 2)) = brr
End With
End Sub
内容全部来源于网络收集，如有侵权，请联系网站删除：QQ：24596024