Public Sub DefautSansDoublon(NomF As String)
Dim Tbl, X, J As Long, A As Integer, TotalA As Integer, Ligne As String ', Nomf As String
Set MonDico = CreateObject("Scripting.Dictionary")
'Nomf = "RécapDéfaut"
With Worksheets(NomF)
L = .Range("G65536").End(xlUp).Row
Tbl = .Range("G2:G" & L)
End With
[COLOR="#FFFF00"] For J = 1 To UBound(Tbl)[/COLOR]
If InStr(Tbl(J, 1), ",") > 0 Then
L = J
X = Split(Tbl(J, 1), ",")
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(X, 1)
If Not MonDico.Exists(Mid(X(i), InStr(X(i), " ") + 1)) Then
MonDico.Add Mid(X(i), InStr(X(i), " ") + 1), Mid(X(i), InStr(X(i), " ") + 1)
End If
Next i
For Each Item In MonDico.items
For i = 0 To UBound(X, 1)
If Mid(X(i), InStr(X(i), " ") + 1) = Item Then
A = Mid(X(i), 1, InStr(X(i), " ") - 1)
TotalA = TotalA + A
If b = "" Then b = Mid(X(i), InStr(X(i), " "))
End If
Next i
If Ligne = "" Then
Ligne = TotalA & b
Else
Ligne = Ligne & "," & TotalA & b
End If
b = "": TotalA = 0
Next Item
With Worksheets(NomF)
.Range("G" & L + 1) = ""
.Range("G" & L + 1) = Ligne
End With
Ligne = ""
End If
Next J
End Sub