Sub commun_unique()
Dim s1 As String, s2 As String, s3 As String, s4 As String
Dim i As Long, j As Long, k As Long, l As Long, v
Dim Ts1(), Ts2(), Su(), Sd()
Application.ScreenUpdating = False
s1 = "Tablo 1"
s2 = "Tablo 2"
s3 = "Valeurs uniques"
s4 = "Doublons"
With Sheets(s1): Ts1 = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).Value: End With
With Sheets(s2): Ts2 = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).Value: End With
ReDim Preserve Ts1(1 To UBound(Ts1, 1), 1 To 4)
ReDim Preserve Ts2(1 To UBound(Ts2, 1), 1 To 4)
For i = 2 To UBound(Ts1, 1)
Ts1(i, 4) = Ts1(i, 1) & "#" & Ts1(i, 2) & "#" & Ts1(i, 3)
Next i
For i = 2 To UBound(Ts2, 1)
Ts2(i, 4) = Ts2(i, 1) & "#" & Ts2(i, 2) & "#" & Ts2(i, 3)
Next i
k = 1
ReDim Su(1 To 4, 1 To k)
Su(1, k) = Ts1(1, 1): Su(2, k) = Ts1(1, 2): Su(3, k) = Ts1(1, 3): Su(4, k) = "Provenance"
l = 1
ReDim Sc(1 To 3, 1 To l)
Sc(1, l) = Ts1(1, 1): Sc(2, l) = Ts1(1, 2): Sc(3, l) = Ts1(1, 3)
For i = 2 To UBound(Ts1, 1)
v = Ts1(i, 4)
If Not IsEmpty(v) Then
For j = 1 To UBound(Ts2, 1)
If Ts2(j, 4) = v Then Exit For
Next j
If j > UBound(Ts2, 1) Then
k = k + 1
ReDim Preserve Su(1 To 4, 1 To k)
Su(1, k) = Ts1(i, 1): Su(2, k) = Ts1(i, 2): Su(3, k) = Ts1(i, 3): Su(4, k) = s1
Else
l = l + 1
ReDim Preserve Sc(1 To 3, 1 To l)
Sc(1, l) = Ts1(i, 1): Sc(2, l) = Ts1(i, 2): Sc(3, l) = Ts1(i, 3)
Ts2(j, 4) = Empty
End If
End If
Next i
For i = 2 To UBound(Ts2, 1)
If Not IsEmpty(Ts2(i, 4)) Then
k = k + 1
ReDim Preserve Su(1 To 4, 1 To k)
Su(1, k) = Ts2(i, 1): Su(2, k) = Ts2(i, 2): Su(3, k) = Ts2(i, 3): Su(4, k) = s2
End If
Next i
With Sheets(s3)
.Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 4)).ClearContents
.Range(.Cells(1, 1), .Cells(k, 4)).Value = Application.Transpose(Su)
End With
With Sheets(s4)
.Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3)).ClearContents
.Range(.Cells(1, 1), .Cells(l, 3)).Value = Application.Transpose(Sc)
End With
Application.ScreenUpdating = True
End Sub