Sub Supprimer_doublons()
Dim d As Object, a, i&, x
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
With [A1].CurrentRegion.EntireRow 'lignes entières pour conserver les hauteurs des lignes
a = .Columns(3).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(a)
x = a(i, 1)
If IsError(x) Then
a(i, 1) = 1
Else
If d.exists(x) Then a(i, 1) = "#N/A" Else a(i, 1) = 1: d(x) = ""
End If
Next
'---restitution et filtrage---
.Columns(3).EntireColumn.Insert 'insère une colonne auxiliaire
.Columns(3) = a
.Sort .Columns(3), xlAscending 'tri pour regrouper et accélérer
On Error Resume Next 'si aucune SpecialCell
.Columns(3).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les doublons
.Columns(3).EntireColumn.Delete 'supprime la colonne auxiliaire
End With
End Sub
Sub Reinitialiser()
If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData 'si la feuille est filtrée
Sheets("Initialisation").Cells.Copy [A1]
[A1].Copy [A1] 'allège la mémoire
End Sub