在选定 Excel 列的单元格中查找并突出显示重复的单元格和文本字符串
Posted
技术标签:
【中文标题】在选定 Excel 列的单元格中查找并突出显示重复的单元格和文本字符串【英文标题】：Find and highlight duplicate cells AND text strings within cells in a selected Excel column 【发布时间】：2021-12-26 20:35:28 【问题描述】：如何突出显示 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
【问题讨论】：
【参考方案1】：这绝对是那些“这应该很容易”的事情之一，最终可能会很快变得丑陋。值得庆幸的是，我们可以在 VBA 中使用一些技巧来使这更容易处理。
-
将逗号/空格分隔的字符串拆分为一个数组，以便我们可以独立处理数组中的每个单词/引用。
使用（滥用）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
【讨论】：
用逗号替换空格是一个非常好的主意，我什至没有想过要尝试使分隔符相同，我应该这样做。不幸的是，在我的测试 Excel 表上尝试这个宏导致列中所有选定的单元格变成红色，甚至是空白单元格。 有趣的结果！我刚刚使用了您建议的字体/内部。如果他们没有重复的单元格应该变成粉红色。如果有重复，则字体变为红色。你得到了哪个？ 所有选中的单元格变成粉红色，字体保持黑色。已知重复的单元格（行项目 105 和 106，参考 R32 和项目 103，参考 R60）文本没有变为红色。 刚刚更新了代码，使单元格突出显示更简单一些。现在它只是将其加粗并将字体变为红色。您能否清除所有选定单元格上的格式，然后尝试一下。当我在你的值列表上运行时，我只会在 R60 副本上得到一个突出显示（红色、粗体）。 这适用于在单个单元格中使用空格或逗号分隔符重复的文本字符串。我感谢你的努力，谢谢。但是，如果分隔符是逗号和空格，则会产生不寻常的结果，但在这种情况下，它也会将行项目 102、107 和 112 的文本变为红色。我猜它认为这些单元格中的某些内容在重复。我试图在您的代码中添加一行以包含“，”分隔符，但我认为它不会那样工作。 referenceVal = Replace(referenceCell.Value, ", ", ",") referenceVal = Replace(referenceCell.Value, " ", ",")以上是关于在选定 Excel 列的单元格中查找并突出显示重复的单元格和文本字符串的主要内容，如果未能解决你的问题，请参考以下文章