多条件匹配数据的同时在找出重复值的问题需要改正

8033

首先感谢chxw68 老师解决了我昨天的问题，我昨天把问题弄反了，想改过来，改不过来了，在找重复值的时候应该是找表一的，我昨天说成表二了，现在想判断表一的，或表一表二都判断下重复数据最好了，谢谢

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   Set d1 = CreateObject("scripting.dictionary")
   
7.   With Worksheets("表二")
   
8.     r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
9.     arr = .Range("b5:e" & r)
   
10.     For i = 1 To UBound(arr)
    
11.       xm = arr(i, 1) & "+" & arr(i, 2) & "+" & arr(i, 3)
    
12.       d(xm) = arr(i, 4)
    
13.     Next
    
14.   End With
    
15.   With Worksheets("表一")
    
16.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
17.     arr = .Range("a6:f" & r)
    
18.     ReDim crr(1 To UBound(arr), 1 To 2)
    
19.     For i = 1 To UBound(arr)
    
20.       xm = arr(i, 3) & "+" & arr(i, 4) & "+" & arr(i, 5)
    
21.       If d.Exists(xm) Then
    
22.         crr(i, 1) = d(xm)
    
23.       Else
    
24.         crr(i, 1) = "无数据"
    
25.       End If
    
26.       If Not d1.Exists(xm) Then
    
27.         d1(xm) = i
    
28.       Else
    
29.         crr(d1(xm), 2) = "重复"
    
30.         crr(i, 2) = "重复"
    
31.       End If
    
32.     Next
    
33.     .Range("i6").Resize(UBound(crr), 2) = crr
    
34.   End With
    
35. End Sub
    

复制代码

chxw68

详见附件。