Sub feuille1_vers_feuille2()
Dim P As Range, t, d As Object, i&, a, b, rest(), s
Set P = Tabelle2.[A1].CurrentRegion.Resize(, 4)
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)
Next
t = Tabelle1.[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
For i = 2 To UBound(t)
If d.exists(t(i, 1)) And t(i, 6) <> "" Or t(i, 6) = "" Then d(t(i, 1)) = t(i, 5) & Chr(1) & t(i, 4) & Chr(1) & t(i, 3)
Next
If d.Count Then
a = d.keys: b = d.items
ReDim rest(UBound(a), 3) '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)
Next
'---restitution---
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, 4) = rest
End If
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(, 4) '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(1) = t(i, 4): 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) & t(i, 4) & 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(UBound(a), 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
'---restitution---
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.Parent.Activate 'facultatif
End Sub