Excel多重复值标注不同颜色

在工作中我们使用Excel难免要遇到一些多种重复值不同颜色筛选这个问题一直很苦恼我们可以使用Excel的VBA宏来完成这个任务废话不多说请看代码

Sub ColorDuplicatesWithIgnore()
    Dim rng As Range
    Dim cell As Range
    Dim dict As Object
    Dim colorIndex As Long
    Dim color As Long
    Dim ignoreList() As String
    Dim ignoreText As String
    
    ' 选择要标注重复值的数据范围
    On Error Resume Next
    Set rng = Application.InputBox("请选择要标注重复值的数据范围:", Type:=8)
    On Error GoTo 0
    
    If rng Is Nothing Then Exit Sub
    
    ' 创建字典对象
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 自定义忽略文本列表
    ignoreText = InputBox("请输入要忽略的文本（使用逗号分隔）:") ' 输入要忽略的文本，多个文本可以使用逗号分隔
    ignoreList = Split(ignoreText, ",") ' 将输入的文本拆分为数组
    
    ' 遍历每个单元格
    For Each cell In rng
        If Not IsEmpty(cell.Value) Then
            ' 检查单元格值是否在忽略列表中
            If Not IsInArray(cell.Value, ignoreList) Then ' 如果单元格的值不在忽略列表中，才进行颜色标注
                ' 如果单元格的值已存在于字典中，则使用已分配的颜色
                If dict.exists(cell.Value) Then
                    color = dict(cell.Value)
                Else
                    ' 如果单元格的值不存在于字典中，则分配一个新的颜色
                    colorIndex = colorIndex + 1
                    color = RGB(Rnd * 255, Rnd * 255, Rnd * 255) ' 随机分配颜色
                    dict.Add cell.Value, color
                End If
                ' 应用颜色到单元格
                cell.Interior.Color = color
            End If
        End If
    Next cell
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    ' 检查字符串是否在数组中
    Dim element As Variant
    For Each element In arr
        If Trim(element) = Trim(stringToBeFound) Then
            IsInArray = True
            Exit Function
        End If
    Next element
    IsInArray = False
End Function

视频如下：