Sub test_2()
Dim i&, J&, Rng As Range
Dim Dico As Object, TData As Variant, TReport As Variant, C As Variant
'Creation d'un dictionnaire
Set Dico = CreateObject("Scripting.dictionary")
'Création de l'objet Range (Rng) avec la plage $A$1 (.Cells(1,1))
'jusqu'a la dernière cellule remplie en colonne A (.Cells(.Rows.Count, 1).End(3))
With Sheets("Feuil1")
Set Rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(3))
End With
'Passage des valeurs de la plage dans le tableau TData
TData = Rng
' Pour chaque ligne du tableau TData
For i = LBound(TData, 1) To UBound(TData, 1)
'On incrémente le dictionnaire
'D.clé = D.Cle valeur
Dico(TData(i, 1)) = Dico(TData(i, 1)) + 1
Next i
'on dimentionne le tableau TReport
'Autant de ligne que de clés dans le dico (1 To Dico.Count)
'1 to 1 pour avoir un tableau à deux dimentions
ReDim TReport(1 To Dico.Count, 1 To 1)
'Pour chaque clé du dico
For Each C In Dico.Keys
'Si la clé na été rencontrée qu'une foi
If Dico(C) = 1 Then
'on incrémente la variable J
J = J + 1
'la ligne J du tableau TReport est égale à la clé du dico
TReport(J, 1) = C
End If
'Prochainee clé
Next C
'Blocage de l'affichage écran (confort visuel ;) )
Application.ScreenUpdating = False
'Avec la plage définie
With Rng
'on la vide
.ClearContents
'on la redimentionne de
'J lignes et 1 colonne
'et on y met le tableau TReport
.Resize(J, 1) = TReport
End With
End Sub