Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, ncol%, resu(), i, x$, j%, nn&, n&
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = [Tableau1] 'tableau structuré, matrice, plus rapide
ncol = UBound(tablo, 2)
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
x = ""
For j = 2 To ncol
If j <> 3 And j <> 6 Then 'Date et Desti exclus
x = x & Chr(1) & tablo(i, j) 'concaténation
End If
Next j
If d.exists(x) Then
nn = d(x)
resu(nn, 1) = resu(nn, 1) & "+" & tablo(i, 1)
Else
n = n + 1
d(x) = n 'mémorise la ligne
resu(n, 1) = tablo(i, 1)
End If
Next i
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
With [M3]
If n Then
.Resize(n) = resu
.Offset(, 1).Resize(n, 13) = "=Rech_Nb(Tableau1,RC" & .Column & ",R1C,""Desti"")"
.Resize(n, 14).Borders.Weight = xlThin 'bordures
End If
With .Offset(n).Resize(Rows.Count - n - .Row + 1, 14)
.ClearContents 'RAZ en dessous
.Borders.LineStyle = xlNone
End With
End With
Application.EnableEvents = True 'réactive les évènements
End Sub