VBA： 随机颜色，同列数据相同值同一颜色（涉及排序，字典）

方法一：先排序，判断下一行与上一行数据是否一致，不致时设置另一底色

Sub SameColor()
    Dim LastRow As Long
    Dim i As Long
    Dim Value  As Variant
    Dim ColorValue As Long
      
    '先按任务单号进行排序
    ActiveSheet.Range("A:Z").Sort key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
      
    ' 获取最后一行的行号
    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
      
    ' 循环检查每一行的值
    For i = 2 To LastRow
        Value  = ActiveSheet.Cells(i, 1).Value '列A为要检查的列
      

        ' 检查是否与上一行的值相同，不同的话，取新的颜色
        If i > 1 And Value  <> ActiveSheet.Cells(i - 1, 1).Value Then
        r = WorksheetFunction.RandBetween(0, 255)
        g = WorksheetFunction.RandBetween(0, 255)
        b = WorksheetFunction.RandBetween(0, 255)
        
        ColorValue = RGB(r, g, b)
        
        End If
        
        ActiveSheet.Cells(i, 1).Interior.Color = ColorValue
    Next i
End Sub

方法二：使用字典的方法,即使顺序是乱的，也可以相同值相同颜色

Sub samecolor2()
  Dim rowsum As Integer
  Dim arr, brr
  Dim i As Integer, j As Integer, k As Integer, r As Integer, g As Integer, b As Integer
  Dim ColorValue1 As Long
  Dim value As Variant, key As Variant

'前期绑定
 Dim d As Scripting.Dictionary
 Set d = New Scripting.Dictionary
''后期绑定
'Dim d As Object
'Set d = CreateObject("Scripting.Dictionary")

  rowsum = ActiveSheet.Range("B1").End(xlDown).row
  arr = ActiveSheet.Range("A2:A" & rowsum)
    For i = 1 To UBound(arr)
      d(arr(i, 1)) = arr(i, 1) '  如是写成“d(arr(i, 1)) =""”会造成后面value值空值
    Next    
k = d.Count '字典中的行数
   
 For i = 1 To k

    r = WorksheetFunction.RandBetween(0, 255)
    g = WorksheetFunction.RandBetween(0, 255)
    b = WorksheetFunction.RandBetween(0, 255)
    
    ColorValue1 = RGB(r, g, b)
    
    value = d.Items(i - 1) '数组中序号从0开始
    ''后期绑定改成：value = d.keys()(i - 1)
    
    '这里判断值是否与字典中的相同，相同的话则设置相应底色
     For j = 2 To rowsum
      If ActiveSheet.Cells(j, 1) = value Then
      ActiveSheet.Cells(j, 1).Interior.Color = ColorValue1
      End If
     Next
 Next
Set d = Nothing

End Sub