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