Extracting Unique values from a list

前端 未结 2 795
庸人自扰
庸人自扰 2020-12-21 10:21

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

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

  Set MyRan         


        
相关标签:
2条回答
  • 2020-12-21 10:30

    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.

    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
    
    0 讨论(0)
  • 2020-12-21 10:53
    Sub FindUniqueValues(SourceRange As Range, TargetCell As Range)
        SourceRange.AdvancedFilter Action:=xlFilterCopy, _
            CopyToRange:=TargetCell, Unique:=True
    End Sub
    
    0 讨论(0)
提交回复
热议问题