【问题标题】：Highlighting duplicate rows突出显示重复的行
【发布时间】：2015-05-31 15:01:16
【问题描述】：

我想突出显示 Excel VBA 中的重复行。假设我有以下示例表，其中包含用于测试的 A、B、C 和 D 列：

 A       B       C       D (Strings)

 1       1       1       dsf
 2       3       5       dgdgdgdg
 1       1       1       dsf
 2       2       2       xxx
 6       3       4       adsdadad
 2       2       2       xxx

应以任何颜色突出显示重复的行，例如灰色的。我正在寻找快速执行的代码，因为它将用于相当大的表。请注意，有一些解决方案可用于突出显示重复的单元格（但不是重复的行）。我不知道如何识别行是否重复，同时如何快速做到这一点，即没有嵌套循环。解决方案应该在 VBA（不是 Excel）中。

实现这一目标的最佳/最快方法是什么？

【问题讨论】：

先排序然后你只需要一个循环来检查一行是否像之前的行？
@pony2deer 我不知道这是否会有所不同，因为您仍然需要为每一行遍历整个表，即使它已排序
即使是内置函数也需要在整个表格中循环至少一次。如果不至少“触摸”一次，您就无法比较值
这就是我在第一条评论中所说的！检查每一行与之前的行。请先阅读
我还需要一个 VBA 解决方案，而不是 Excel 解决方案。我当然可以录制一个宏，所以这是一个小问题。但是使用 VBA，您通常可以做的不仅仅是使用宏。

标签： excel vba performance loops

【解决方案1】：

使用以下 sumproduct 公式（或计数）添加条件格式

=SUMPRODUCT(($A$1:$A$6&$B$1:$B$6&$C$1:$C$6=$A1&$B1&$C1)*1)>1

解释：

SUMPRODUCT 可以方便地处理在检查条件之前需要操作的范围。在这种情况下，我将整个范围内的 A、B 和 C 列连接起来，并将其与当前行的连接进行比较。然后我通过乘以 1 将 TRUE/FALSE 数组转换为 1/0 数组，SUMPRODUCT 的 SUM 部分将条件为真的行求和，给我重复的行（所有出现）。如果你的范围很小，使用公式评估你可以清楚地看到它是如何工作的。

这是一个快速修复，但性能并不理想，我经常使用它来检测重复或生成序列号。

来自 ponydeer 建议的 cmets 的解决方案 - 更高的性能

根据排序建议，需要添加键列，放入自动过滤器并按键排序，然后对键列进行条件：

【讨论】：

不确定为什么投反对票，该解决方案有效 - 尽管它可能不是大型工作表的最佳性能（在工作表上关闭自动计算并使用 SHIFT+F9 刷新）
++ 的解决方案。我自己可能用过更高效的COUNTIFS function；也许在定义 .CurrentRegion 的命名范围内。
我没有投反对票。但不幸的是，它不起作用，因为我的列也包含字符串。抱歉，我应该提到这一点。
@EDC - 尝试使用=countifs(($A:$A, $A1, $B:$B, $B1, $C:$C, $C1, $D:$D, $D1)>1 作为 CF 规则公式。
@Jeeped 这可能有效，但我需要先在 VBA 中对其进行测试。正如我在上面编辑的那样，我需要一个 VBA 解决方案，而不是 Excel 解决方案。但是你。

【解决方案2】：

我在 OP 的评论中对示例文件 link 测试了 3 种不同的方法。可能 VBA 实现不是最优的，但以下是平均 100 次通过的结果：

1) 条件格式使用：

a)SUMPRODUCT 连接列 - 3s

b) COUNTIFS 完整列引用 - 1.9 秒

c) COUNTIFS 引用使用的范围 - 0.2s

2) 对所有列的范围进行排序，逐行比较，向后排序 - 0.3s

3) 使用高级过滤器 3.5s

这是最快方法的代码：

Sub CF1()

    Application.ScreenUpdating = False

    Dim sFormula As String
    Dim rRng As Range
    Dim nCol As Integer, i As Integer

    Set rRng = Range("A1").CurrentRegion
    nCol = rRng.Columns.Count

    'build the formula
    sFormula = "=COUNTIFS("

    For i = 1 To nCol
      sFormula = sFormula & rRng.Columns(i).Address & "," & _
         rRng.Cells(1, i).Address(False, True)
      If i < nCol Then sFormula = sFormula & ","
    Next
    sFormula = sFormula & ")>1"

    'write the formula in helper cell to get it's local version
    rRng.Cells(1, nCol + 1).Formula = sFormula

    rRng.FormatConditions.Delete
    With rRng.FormatConditions.Add(Type:=xlExpression, _
            Formula1:=rRng.Cells(1, nCol + 1).FormulaLocal)
       .Interior.ThemeColor = xlThemeColorAccent3
    End With

    rRng.Cells(1, nCol + 1).Clear

    Application.ScreenUpdating = True
End Sub

【讨论】：

感谢您的时间和精力！伟大的溶胶。您能否也提供高级过滤器的代码？
甜蜜的东西！您能否也发布您的基准代码，我对使用字典并测试是否存在键的 VBA 方法感兴趣（尽管字典对象将通过 COM 调用，因此实际上可能也很慢）
@VincentDeSmet benchmark 代码非常简单 - GetTickCount API 调用之前和之后运行每个 Sub 的 100 次调用的循环。我不确定这是否是最好的方法，但我认为这足以进行一般的速度比较。

【解决方案3】：

首先对所有列的范围进行排序

 Workbooks(1).Sheets(1).Range("A:C").Sort Key1:=Workbooks(1).Sheets(1).Range("A:A"), Order1:=xlAscending, Key2:=Workbooks(1).Sheets(1).Range("B:B"), Order2:=xlAscending, Key3:=Workbooks(1).Sheets(1).Range("C:C"), Order3:=xlAscending, Orientation:=xlSortRows

然后遍历所有行并将它们与上面的行进行比较

 Dim a As Application
 Set a = Application

 For i=1 to 1000 ' here you need to set the number of rows you have
   if Join(a.Transpose(a.Transpose(ActiveSheet.Rows(i).Value)), Chr(0)) = _
   Join(a.Transpose(a.Transpose(Sheets(1).Rows(i+1).Value)), Chr(0)) then

      Sheets(1).Range(i+1 & ":" & i+1).EntireRow.Interior.Color = 49407

   end if

 Next i

两行的比较基于这个线程：How to compare two entire rows in a sheet

请在代码中插入您的工作簿、工作表的名称并设置您的范围和限制。

【讨论】：

谢谢，我会试试看！
我刚刚注意到的一件事：我可以在之后恢复排序吗？我想保留原始顺序，因为它包含有关时间的信息（上面的行是较早创建的等）。
也许这个帖子的最后一篇，就是你要找的windowssecrets.com/forums/showthread.php/…

【解决方案4】：

我认为最快/最好将取决于重复的比例——只有一行应该快于示例中的 50%——以及数组的实际大小（从多少列创建一个键等）。

鉴于几乎不可能使用“纯”VBA 击败内置函数，我怀疑使用 UI，如果需要，在 VBA 中使用，在某些情况下会更快。例如：

添加一个索引列（系列填充将服务），复制整个工作表（比如Sheet2），将Remove Duplicates应用于除索引列之外的所有列，然后将原始工作表的相关范围作为这种CF公式规则应用：

=$A1=MATCH($A1,Sheet2!$A$1:$A$3000,0)>0

假设起点是这样的：

并且插入的 ColumnA 以 1 开头的数字系列填充，Sheet2 在删除重复项后应该是这样：

就重复而言，我假设 ColumnE 将被忽略。

在源工作表中，选择数组（来自 A1：-see!），例如 A1:I6 和 HOME >样式 - 条件格式，新规则...，使用公式确定要格式化的单元格, 在此公式为真时格式化值：：

=$A1=MATCH($A1,Sheet2!$A:$A,0)>0

格式...，填充，灰色，OK，OK。

对我来说结果：

【讨论】：

听起来很有趣，但我不知道您的意思是：'将原始表格的相关范围作为这种CF公式规则应用：=$A1=MATCH($A1,Sheet2!$A$1:$A$3000,0)>0'。删除重复项后，我会完成吗？
我认为在这种方法中 CF 将仅突出显示两个相同行中的一个（或 n-1 行）
如果可以只突出显示duplicates（而不是original），则可以使用另一种解决方案 - 使用advanced filter->unique values only 并将original 格式应用于所有可见单元格。
抱歉，我不明白我更喜欢排序和过滤 - 高级，因为这正是我的意思。我不使用英文版的 excel，它不是我的母语，所以可能我不够清楚
@pnuts 只是想补充一下，这正是我想要的。如果使用（高级）过滤器，与循环相比，该解决方案可能会快得多。

【解决方案5】：

Sub HighlightDuplicateRows_2()

  'This one is more modifiable and can handle multiple columns of data
  'Just add another *WorksheetFunction.CountIf(Range("A2:A" & LastRow),Cells(r,1).Value) > 1* and change the column values

  Dim LastRow As Long

  LastRow = Cells(Rows.Count, "A").End(xlUp).Row

  For r = 2 To LastRow

    If WorksheetFunction.CountIf(Range("A2:A" & LastRow), Cells(r, 1).Value) > 1 And WorksheetFunction.CountIf(Range("B2:B" & LastRow), Cells(r, 2).Value) > 1 Then
    Rows(r).Interior.ColorIndex = 6
    End If

  Next r

End Sub

【讨论】：