在选定 Excel 列的单元格中查找并突出显示重复的单元格和文本字符串

Question

如何突出显示 Excel 列中包含重复文本字符串的单元格？

虽然它对重复的单元格非常有效，但在条件格式功能中似乎没有任何方法可以做到这一点。

我经常遇到客户物料清单的问题，其中包含重复的参考。在提供的示例中，参考 R60 在项目 103 中列出了两次，参考 R32 在项目 105 和 106 中的两个不同行中。因此，仅查找重复的单元格是行不通的。

示例（从 Excel 中粘贴，由于某种原因它不允许我插入图片）：

Item	Qty	Reference
100	1	U12
101	1	U3
102	5	R38,R39,R40,R41,R45
103	1	R60,R60
104	1	R13
105	2	R17,R32
106	2	R32,R43
107	8	R8-9,R26,R30,R36,R44,R58,R61
108	2	R19,R24
109	2	R53,R59
110	3	R16,R46-47

此外，不同的客户会以不同的方式区分参考。有些使用逗号，有些使用空格，有些使用逗号和空格。有时他们会使用它们的组合。给定单元格中可能有数百个引用，因此使用文本到列然后使用条件格式（我在类似的帖子中看到建议作为可能的解决方案）对我不起作用。理想情况下，如果有解决方案，它将考虑所有这些。能够选择分隔符也可能有效。

基于几个小时的网络搜索和实验，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' ' DuplicateRed Macro ' First, turn duplicate

最终，我希望能够选择引用列（或其中的一部分），然后在该选择上运行 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

Answer 1

这绝对是那些“这应该很容易”的事情之一，最终可能会很快变得丑陋。值得庆幸的是，我们可以在 VBA 中使用一些技巧来使这更容易处理。

1. 将逗号/空格分隔的字符串拆分为一个数组，以便我们可以独立处理数组中的每个单词/引用。
2. 使用（滥用）Scripting.Dictionary，因为字典只允许唯一键。如果您将存储在数组中的引用列表与存储在字典中的引用列表进行比较并且计数不同，则包含原始列表的数组必须有重复项

这是一个工作示例：

Sub highlight_duplicates()

    '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, " ", ",")
        
        '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
    
End Sub