Sub Doublons()
Dim Unique As Object, Cel As Range
Set Unique = CreateObject("Scripting.Dictionary")
For Each Cel In Range("a2:a" & [a65000].End(xlUp).Row)
If Not Unique.Exists(Cel.Value) Then Unique.Add Cel.Value, Cel.Value
Next Cel
Range("a2:a" & [a65000].End(xlUp).Row).Delete Shift:=xlUp
Range("a2:a" & Unique.Count + 1) = Application.Transpose(Unique.items)
End Sub
Sub nbDoublons()
Dim i As Integer, j As Byte, plage As Range, prec As String
Application.ScreenUpdating = False
Set plage = Range("A2:A500")
prec = ""
For i = 1 To 500
For j = 2 To 28
With Application.WorksheetFunction
If .CountIf(plage, Cells(i, j)) > 1 And Cells(i, j) <> prec Then
MsgBox "Il y a " & .CountIf(plage, Cells(i, j)) & " fois la valeur " & Cells(i, j)
End If
End With
prec = Cells(i, j)
Next j
Next i
End Sub