如何高亮Excel列中含重复文本（含单元格内/跨单元格重复）的单元格

条件格式功能可以完美识别完全重复的单元格，但似乎无法处理单元格内存在重复字符串的场景。

我在处理客户物料清单（BOM）时经常遇到重复位号引用的问题，比如示例中103行的单元格内R60出现了两次，R32同时出现在105和106两个不同行的单元格中，仅检测重复单元格的方案无法满足需求。

示例（从Excel粘贴，暂无法插入图片）：

此外不同客户的位号分隔符不统一，部分用逗号，部分用空格，还有部分用逗号加空格，偶尔会出现多种分隔符混用的情况。单个单元格内可能存在数百个引用，因此我看到同类帖子中建议的「分列+条件格式」方案并不适用。理想的解决方案可以兼容上述分隔符场景，支持自定义分隔符的话更佳。

经过数小时的网络搜索和测试，我发现COUNTIF函数似乎是实现该需求的核心，但我对该函数的用法和调整方法并不熟悉。

以下是我正在编写的VBA代码，第一部分是调用条件格式功能，第二部分是我找到的两段代码的整合版本，可能用法有误，我是VBA编程新手，提前抱歉代码不够规范。

Sub DuplicateRed() 
 
'
' DuplicateRed Macro
' First, turn duplicate cells red and second, duplicate text strings Within cells Red 
' - November 15 2021
 
' First, turn duplicate cells Red

    Dim r As Range ' Runs the macro on the selected column / cells

    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
'Second, turn any duplicate text stings within cells Red

  Range(Addr) = Evaluate("IF(COUNTIF(" & Addr & "," & Addr & ")>1,""=""&" & Addr & "," & Addr & ")")   
  On Error Resume Next  
  Range(Addr).SpecialCells(xlFormulas).Interior.ColorIndex = 6  
  Range(Addr).Replace "=", "", xlPart
 
' Locate duplicate values in selected range

        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed        ' CHANGE COLOR TO RED.
        End If  
    Next cell
     
    Set myDataRng = Nothing 
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
     End Sub

我最终的需求是：选中引用位号列（或其中部分区域）后，运行VBA脚本即可高亮所有存在重复引用的单元格，我不需要删除这些重复值，因为我需要告知客户其物料清单中存在的错误。

编辑：在JNevill帮助下优化的新版VBA代码 #

Sub highlight_duplicates()

' Turn duplicate cells and duplicate text strings within cells Red
' November 15 2021
' Credit to JNevill

'First, turn any duplicated text stings within cells Red

    'Declare variables used in this script
    Dim referenceRange As Range
    Dim referenceCell As Range
    Dim referenceArray As Variant
    Dim referenceVal As String
    Dim referenceItem As Variant
    
    'Grab the selection into a variable
    Set referenceRange = Selection
    
    'iterate through each cell in the range
    For Each referenceCell In referenceRange
    
        'Because we can have either a space or a comma as a delimiter,
        '  lets make them all comma so it's easier to deal with.
        '  Note this doesn't change the value in the cell, just the
        '  variable here in VBA.
        referenceVal = Replace(referenceCell.Value, ", ", ",")
        referenceVal = Replace(referenceCell.Value, " ", ",")
        
        'Break this thing into an array so it's easier to work with each
        '  value. The big advantage here is that we can iterate through
        '  an array, where iterating through a string is a nightmare.
        referenceArray = Split(referenceVal, ",")
        
        'We will use a dictionary to determine if there are duplicates in
        '  in this array. By definition an item in a dictionary can not be
        '  a duplicate so we just dump all the values of the array into
        '  the dictionary and then count elements of both the dictionary
        '  and the array. If they are they same, then the array has no
        '  duplicates.
        With CreateObject("Scripting.Dictionary")
        
            'Dump array into dictionary
            For Each referenceItem In referenceArray
                If Not .Exists(referenceItem) Then .Add referenceItem, 1
            Next referenceItem
            
            'Toggle looks of cell based on uniqueness
            If .Count < UBound(referenceArray) + 1 Then
                With referenceCell.Font
                    .Color = -16383844
                    .Bold = True
                End With
            Else
                With referenceCell.Font
                    .Color = 1
                    .Bold = False
                End With
            End If
            
        End With
    
    Next referenceCell
    
' Second, turn duplicate cells Red

    Dim r As Range
' Runs the macro on the selected column

    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False


End Sub

内容的提问来源于stack exchange，提问作者WhiteLancer64