Sub Communs()
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)
clé = a(i, 1) & a(i, 3) & Int(a(i, 7))
mondico1(clé) = a(i, 7)
clé = a(i, 1) & a(i, 3) & Int(a(i, 7)) + 1
mondico1(clé) = a(i, 7)
clé = a(i, 1) & a(i, 3) & Int(a(i, 7)) - 1
mondico1(clé) = a(i, 7)
Next i
ligne = 1
Dim c
ReDim c(1 To Application.Max(UBound(a), UBound(b)), 1 To 6)
For i = 2 To UBound(b)
clé = b(i, 5) & b(i, 2) & Int(b(i, 7))
If mondico1.Exists(clé) Then
c(ligne, 1) = b(i, 5)
c(ligne, 2) = b(i, 2)
c(ligne, 3) = b(i, 11)
c(ligne, 4) = b(i, 4)
c(ligne, 5) = b(i, 7)
c(ligne, 6) = mondico1(clé)
ligne = ligne + 1
End If
Next
Sheets("Resultats").[A4].Resize(UBound(c, 1), UBound(c, 2)) = c
Sheets("Resultats").[A4].Resize(UBound(c, 1)) = Application.Index(c, , 1) 'dates
End Sub