Extraction des valeurs uniques à partir d'une liste

Question

je le code suivant qui retourne 50 numéros codés de couleurs aléatoires:

Sub RandomNumberColor() 
    Dim Numbers, i As Integer 
    Dim MyRange As Range 

    Set MyRange = Worksheets("Rnd").Range("A1:A50") 

    For i = 1 To MyRange.Rows.Count 
    Numbers = Int((10 - 1 + 1) * Rnd + 1) 
    Worksheets("Rnd").Cells(i, 1) = Numbers 
    Worksheets("Rnd").Cells(i, 1).Interior.ColorIndex = Worksheets("Rnd").Cells(i, 1).Value 
    Next i 

End Sub 

Je suis en train de trouver un moyen de trouver toutes les valeurs uniques dans cette colonne (A), et les renvoie à la colonne (B). Pour une raison quelconque, j'ai des problèmes à comprendre, toute aide serait très appréciée!

Answer 1

Sub FindUniqueValues(SourceRange As Range, TargetCell As Range) 
    SourceRange.AdvancedFilter Action:=xlFilterCopy, _ 
     CopyToRange:=TargetCell, Unique:=True 
End Sub 

Answer 2

Vous pouvez probablement découper certaines lignes à partir de cela, mais ce qui suit est efficace.
Dans la première boucle, nous remplissons un dictionnaire (table de hachage) avec des valeurs uniques RandNum, puis nous parcourons ce dictionnaire.

Sub RandomNumberColor() 
    Dim RandNum As Integer 
    Dim i As Integer 
    Dim MyRange As Range 

    Set dict = CreateObject("Scripting.Dictionary") 

    Set MyRange = Worksheets("Rnd").Range("A1:A50") 

    For i = 1 To MyRange.Rows.Count 
     RandNum = Int((10 - 1 + 1) * Rnd + 1) 
     Worksheets("Rnd").Cells(i, 1) = RandNum 
     Worksheets("Rnd").Cells(i, 1).Interior.ColorIndex = _ 
     Worksheets("Rnd").Cells(i, 1).Value 

     If Not dict.Exists(RandNum) Then 
      dict.Add RandNum, RandNum 
     End If 
    Next i 

    i = 1 
    For Each key In dict.Keys() 
     Worksheets("Rnd").Cells(i, 2) = dict(key) 
     i = i + 1 
    Next 

    Set dict = Nothing 
    Set MyRange = Nothing 
End Sub