从列表中提取唯一值

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

我试图find一种方法来find该列（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