两个数组去重合并

Hellocola_2020

Sub 去重再合并()
Dim Dic As Object
Dim Arr, Brr, Rrr, Crr, Krr
Set Dic = CreateObject("scripting.dictionary")
Arr = Range("C3:E14")
Brr = Range("G3:i14")
For i = 1 To UBound(Brr)
    Dic(Brr(i, 1) & "|" & Brr(i, 2)) = Brr(i, 3)
Next
For j = 1 To UBound(Arr)
    If Dic.exists(Arr(j, 1) & "|" & Arr(j, 2)) Then Dic.Remove (Arr(j, 1) & "|" & Arr(j, 2))
Next
ReDim Crr(1 To UBound(Arr) + Dic.Count, 1 To 3)
For n = 1 To UBound(Arr)
    Crr(n, 1) = Arr(n, 1): Crr(n, 2) = Arr(n, 2): Crr(n, 3) = Arr(n, 3)
Next
Rrr = Dic.keys
For m = 0 To Dic.Count - 1
    Krr = Split(Rrr(m), "|")
    Crr(n + m, 1) = Krr(0): Crr(n + m, 2) = Krr(1): Crr(n + m, 3) = Dic.Item(Rrr(m))
Next
    Range("O2").Resize(UBound(Crr), UBound(Crr, 2)) = Crr
End Sub

Hellocola_2020

ykcbf1100

应该有4行重复，“I"也是重复的。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.27
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 3).End(3).Row
   
4.     arr = [c1].Resize(r, 3)
   
5.     r = Cells(Rows.Count, 8).End(3).Row
   
6.     brr = [g1].Resize(r, 3)
   
7.     ReDim crr(1 To UBound(arr) + UBound(brr), 1 To 3)
   
8.     For x = 1 To 2
   
9.         If x = 2 Then arr = brr
   
10.         For i = 3 To UBound(arr)
    
11.             s = arr(i, 1) & "|" & arr(i, 2)
    
12.             If Not d.exists(s) Then
    
13.                 m = m + 1
    
14.                 d(s) = m
    
15.                 For j = 1 To UBound(arr, 2)
    
16.                     crr(m, j) = arr(i, j)
    
17.                 Next
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     [k3].Resize(1000, 3) = ""
    
22.     [k3].Resize(m, 3) = crr
    
23. End Sub
    

复制代码

一招秒杀

1句2行，还有更简单的吗