突出显示不同工作表上两个范围之间的重复项答案

【问题标题】：Highlight Duplicates between two ranges on different worksheets突出显示不同工作表上两个范围之间的重复项
【发布时间】：2015-11-10 13:55:42
【问题描述】：

我正在尝试找到一种更有效的方法来突出显示不同工作表上两个范围之间的重复单元格。下面的代码非常慢：

    Sub HighlightDuplicates()
Application.DisplayAlerts = False

lrU = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lrPT = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

Dim rng1, rng2, cell1, cell2 As Range

Set rng1 = Worksheets("Sheet1").Range("DL4:DL" & lrU)
Set rng2 = Worksheets("Sheet2").Range("E3:M" & lrPT)

    For Each cell1 In rng1

        For Each cell2 In rng2

            If cell1.Value = cell2.Value Then

            cell1.Font.Bold = True
            cell1.Font.ColorIndex = 2
            cell1.Interior.ColorIndex = 3
            cell1.Interior.Pattern = xlSolid
            cell2.Font.Bold = True
            cell2.Font.ColorIndex = 2
            cell2.Interior.ColorIndex = 3
            cell2.Interior.Pattern = xlSolid

            End If

        Next cell2
     Next cell1
Application.DisplayAlerts = True
End Sub

对更有效的方法有什么建议吗？

感谢您的帮助。

问候，

【问题讨论】：

你试过条件格式吗？
尝试在底部添加Application.Calculation=xlCalculationManual和Application.ScreenUpdating=false at the top and 1Application.Calculation=xlCalculationAutomatic和Application.ScreenUpdating=true。
如果您想要高效，您可能需要避免使用 VBA，而只使用直接公式（或凯尔提到的格式）。我通常在我专用的一张纸上的列中使用一个公式（即MATCH）...
还可以考虑使用Find 方法。您可以只循环一个范围并尝试使用Find 方法在另一个范围中查找每个值。见here。
对于@Kyle 的评论，条件格式不是一个选项吗？它可能会快一点，并且不需要宏/VB。

标签： excel vba duplicates highlight

【解决方案1】：

把我的 cmets 放在一起，你可以修改你的代码看起来像这样（未经测试）

Sub HighlightDuplicates()
Application.DisplayAlerts = False
application.calculation=xlcalculationmanual
application.screenupdating=false

lrU = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
lrPT = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

Dim rng1, rng2, cell1, cell2 As Range

Set rng1 = Worksheets("Sheet1").Range("DL4:DL" & lrU)
Set rng2 = Worksheets("Sheet2").Range("E3:M" & lrPT)

For Each cell2 In rng2
    Set cell1 = rng1.Find(cell2, lookin:=xlValues)
    if not cell1 is nothing then
        firstAddress = cell1.address
        Do
            cell1.Font.Bold = True
            cell1.Font.ColorIndex = 2
            cell1.Interior.ColorIndex = 3
            cell1.Interior.Pattern = xlSolid
            cell2.Font.Bold = True
            cell2.Font.ColorIndex = 2
            cell2.Interior.ColorIndex = 3
            cell2.Interior.Pattern = xlSolid
            Set cell1 = rng1.FindNext(cell2)
        Loop While Not cell1 Is Nothing And cell1.Address <> firstAddress 
    end if
next cell1

application.displayalerts=true
application.calculation=xlcalculationmanual
application.screenupdating=true
end sub

【讨论】：

非常感谢您的回答。我认为我在每个范围内拥有的单元格数量可能太多，Excel 无法处理。一切都在运行，但仍然需要大约 5 分钟。
所以我的代码有效，但花了 5 分钟。你说的是这个吗？
是的。这与我的宏所用的时间长度大致相同。
看起来rng2 是两个范围中较大的一个。也许循环通过rng1 并在rng2 上查找。