Sub doublon()
Set Plage = Range([A1], [A65536].End(xlUp))
T = doublons(Plage.Value, 1)
If IsArray(T) Then
T = InverseTab(T, 1)
With Plage
.Clear
.Cells(1, 1).Resize(UBound(T), UBound(T, 2)) = T
End With
Else: MsgBox T
End If
End Sub
Function doublons(T, ColT As Byte)
Dim i&, J&, k&, Tablo As New Collection
Dim Temp()
For i = LBound(T, 1) To UBound(T, 1)
On Error Resume Next
Tablo.Add T(i, ColT), CStr(T(i, ColT))
If Err = 0 Then
ReDim Preserve Temp(1 To UBound(T, 2), 1 To J + 1)
For k = 1 To UBound(Temp)
Temp(k, J + 1) = T(i, k)
Next k
J = J + 1
End If
Next i
doublons = IIf(J > 0, Temp, 'Pas de doublons')
End Function
Function InverseTab(T, Optional Base As Byte = 0)
Dim Temp(), i&, J&
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For i = LBound(T, 2) To UBound(T, 2)
For J = LBound(T) To UBound(T)
Temp(i, J) = T(J, i)
Next J
Next i
InverseTab = Temp
End Function