從列表

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 

我試圖找到一種方法來找到在該列（A）中的所有唯一值，並將它們返回到列（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