Sub feuille1_vers_feuille2()
Dim t, P As Range, rest(), d As Object, i&, a, b, s
t = Tabelle1.[A1].CurrentRegion.Resize(, 5) 'matrice, plus rapide
Set P = Tabelle2.[A1].CurrentRegion.Resize(, 3)
ReDim rest(UBound(t) + P.Rows.Count - 2, 2) 'base 0
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(t)
d(t(i, 1)) = t(i, 5) & Chr(1) & t(i, 4)
Next
t = P 'matrice, plus rapide
For i = 2 To UBound(t)
If Not d.exists(t(i, 1)) Then d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3)
Next
If d.Count Then
a = d.keys: b = d.items
For i = 0 To UBound(a)
rest(i, 0) = a(i)
s = Split(b(i), Chr(1))
rest(i, 1) = s(0): rest(i, 2) = s(1)
Next
'---restitition---
If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
P(2, 1).Resize(d.Count, 3) = rest
End If
P.CurrentRegion.Sort P(1), xlAscending, Header:=xlYes 'tri facultatif
P.Parent.Activate 'facultatif
End Sub
Sub feuille2_vers_feuille1()
Dim P As Range, t, d As Object, i&, s, a, b, rest()
Set P = Tabelle1.[A1].CurrentRegion.Resize(, 5)
t = P 'matrice, plus rapide
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(t)
d(t(i, 1)) = t(i, 2) & Chr(1) & t(i, 3) & Chr(1) & t(i, 4) & Chr(1) & t(i, 5)
Next
t = Tabelle2.[A1].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(t)
If d.exists(t(i, 1)) Then
s = Split(d(t(i, 1)), Chr(1))
s(2) = t(i, 3): s(3) = t(i, 2) 'remplacement
d(t(i, 1)) = Join(s, Chr(1))
Else
d(t(i, 1)) = Chr(1) & Chr(1) & t(i, 3) & Chr(1) & t(i, 2)
End If
Next
If d.Count Then
a = d.keys: b = d.items
ReDim rest(P.Rows.Count + UBound(t) - 2, 4) 'base 0
For i = 0 To UBound(a)
rest(i, 0) = a(i)
s = Split(b(i), Chr(1))
rest(i, 1) = s(0): rest(i, 2) = s(1): rest(i, 3) = s(2): rest(i, 4) = s(3)
Next
'---restitition---
If P.Parent.FilterMode Then P.Parent.ShowAllData 'si la feuille est filtrée
If P.SpecialCells(xlCellTypeVisible).Count < P.Count Then _
P.AutoFilter: P.AutoFilter 'défiltrage si tableau Excel
P(2, 1).Resize(d.Count, 5) = rest
End If
P.CurrentRegion.Sort P(1), xlAscending, Header:=xlYes 'tri facultatif
P.Parent.Activate 'facultatif
End Sub