Sub CompareBD()
Application.ScreenUpdating = False
't = Timer()
Set f1 = Sheets("BD1")
Set f2 = Sheets("BD2")
Set f3 = Sheets("ecart")
ligne = 1
n1 = f1.Range("A65000").End(xlUp).Row
n2 = f2.Range("A65000").End(xlUp).Row
a = f1.Range("A2:C" & n1).Value
b = f2.Range("A2:C" & n2).Value
Set mondico1 = CreateObject("Scripting.Dictionary")
For I = 1 To n1 - 1: mondico1.Add a(I, 1), I: Next
Set mondico2 = CreateObject("Scripting.Dictionary")
For I = 1 To n2 - 1: mondico2.Add b(I, 1), I: Next
Dim c()
n = n1 + n2
ReDim c(1 To n, 1 To 6)
[A2:L30000].ClearContents
'--- communs
For I = 1 To n1 - 1
temp = a(I, 1)
If mondico2.Exists(temp) Then
p = mondico2.Item(temp)
For K = 1 To 3: c(ligne, K) = a(I, K): Next K
c(ligne, 4) = b(p, 3)
c(ligne, 5) = b(p, 3) - a(I, 3)
c(ligne, 6) = "Communs"
ligne = ligne + 1
End If
Next I
'--- BD2-BD1
For I = 1 To n2 - 1
temp = b(I, 1)
If Not mondico1.Exists(temp) Then
p = mondico2.Item(temp)
For K = 1 To 3: c(ligne, K) = b(I, K): Next K
c(ligne, 5) = b(p, 3)
c(ligne, 6) = f2.Name
ligne = ligne + 1
End If
Next I
'--- BD1-BD2
For I = 1 To n1 - 1
temp = a(I, 1)
If Not mondico2.Exists(temp) Then
p = mondico1.Item(temp)
For K = 1 To 3
c(ligne, K) = a(I, K)
Next K
c(ligne, 5) = -a(p, 3)
c(ligne, 6) = f1.Name
ligne = ligne + 1
End If
Next I
f3.[a2].Resize(ligne, 6) = c
'MsgBox Timer() - t
End Sub
Sub BD1_BD2()
Application.ScreenUpdating = False
Set f1 = Sheets("BD2")
Set f2 = Sheets("BD1")
a = f1.Range("A1").CurrentRegion.Value
b = f2.Range("A1").CurrentRegion.Value
Set mondico1 = CreateObject("Scripting.Dictionary")
For I = 2 To UBound(a)
mondico1(a(I, 1)) = ""
Next I
ligne = 1
Dim c
ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
For I = 2 To UBound(b)
temp = ""
For K = 1 To UBound(b, 2): temp = temp & b(I, K): Next K
If Not mondico1.Exists(b(I, 1)) Then
For K = 1 To UBound(b, 2): c(ligne, K) = b(I, K): Next K
c(ligne, K) = I
ligne = ligne + 1
End If
Next
Sheets("BD1 NON BD2").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c
End Sub
Sub BD2_BD1()
Application.ScreenUpdating = False
Set f1 = Sheets("BD1")
Set f2 = Sheets("BD2")
a = f1.Range("A1").CurrentRegion.Value
b = f2.Range("A1").CurrentRegion.Value
Set mondico1 = CreateObject("Scripting.Dictionary")
For I = 2 To UBound(a)
mondico1(a(I, 1)) = ""
Next I
ligne = 1
Dim c
ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To UBound(a, 2) + 1)
For I = 2 To UBound(b)
temp = ""
For K = 1 To UBound(b, 2): temp = temp & b(I, K): Next K
If Not mondico1.Exists(b(I, 1)) Then
For K = 1 To UBound(b, 2): c(ligne, K) = b(I, K): Next K
c(ligne, K) = I
ligne = ligne + 1
End If
Next
Sheets("BD2 NON BD1").[a2].Resize(UBound(a, 1), UBound(a, 2) + 1) = c
End Sub