Извлечение уникальных значений из списка

Question

У меня есть следующий код, который возвращает 50 случайных цветные цифры:

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 

Я пытаюсь найти способ, чтобы найти все уникальные значения в этом столбце (А), и возвращает их в колонку (B). По какой-то причине у меня возникают проблемы с этим, любая помощь будет очень признательна!

Answer 1

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

Answer 2

Возможно, вы можете обрезать несколько строк, но следующее делает трюк.
В первом цикле мы заполняем словарь (хеш-таблицу) только с уникальными значениями RandNum, затем мы перебираем этот словарь.

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