从列表中提取唯一值

I have the following code that returns 50 random color-coded numbers:

我有以下代码返回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

I am trying to find a way to find all the unique values in that column (A), and returns them to Column (B). For some reason, I am having issues figuring this out, any help would be much appreciated!

我试图找到一种方法来查找该列（A）中的所有唯一值，并将它们返回到列（B）。由于某种原因，我有问题解决这个问题，任何帮助将不胜感激！

2 个解决方案

#1

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

#2

You can probably trim some lines from this, but the following does the trick.
In the first loop we populate a dictionary (hash-table) with only unique RandNum values, then we iterate over that dictionary.

你可以从中修剪一些线条，但以下是诀窍。在第一个循环中，我们使用唯一的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