从工作簿中的多个工作表中查找重复项 [英] Find duplicates from multiple sheets in a workbook

问题描述

我一张纸上有60万条数据.在列I"中，我在Sheet1，sheet2，sheet3和sheet4中有电话号码.我想比较工作表中的重复项并突出显示其中的重复值.

I have a 600 000 data in one sheet. In "column I", I have phone numbers in Sheet1, sheet2, sheet3 and sheet4. I want to compare duplicates across sheets and highlight duplicate values in it.

有人可以帮我吗?

推荐答案

这将突出显示工作表中的重复项.您可以使用简单的Conditional Formatting在同一张纸上标注重复项.

This will highlight duplicates across sheets. You can use simple Conditional Formatting to call out duplicates on the same sheet.

更新:如果每个工作表具有10,000个相同的行，则在关闭ScreenUpdating的情况下，宏需要2分钟(准确的说是156.4063秒)来运行.这意味着在此时序测试中突出显示了30,000个单元格.

Update: If each sheet has 10,000 identical rows, the macro takes 2 minutes (or 156.4063 seconds to be precise) to run with ScreenUpdating toggled off. That means 30,000 cells were highlighted on this timing test.

Option Explicit

Sub Duplicate_Digits()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Sheet3")
Dim Numbers1, Numbers2, Numbers3, i
Dim Found As Range

Numbers1 = ws1.Range("I2:I" & ws1.Range("I" & ws1.Rows.Count).End(xlUp).Row).Value
Numbers2 = ws2.Range("I2:I" & ws2.Range("I" & ws2.Rows.Count).End(xlUp).Row).Value
Numbers3 = ws3.Range("I2:I" & ws3.Range("I" & ws3.Rows.Count).End(xlUp).Row).Value

For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
    Set Found = ws1.Range("I:I").Find(Numbers2(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers3, 1) To UBound(Numbers3, 1)
    Set Found = ws1.Range("I:I").Find(Numbers3(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
    Set Found = ws2.Range("I:I").Find(Numbers1(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers3, 1) To UBound(Numbers3, 1)
    Set Found = ws2.Range("I:I").Find(Numbers3(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers1, 1) To UBound(Numbers1, 1)
    Set Found = ws3.Range("I:I").Find(Numbers1(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

For i = LBound(Numbers2, 1) To UBound(Numbers2, 1)
    Set Found = ws3.Range("I:I").Find(Numbers2(i, 1))
        If Not Found Is Nothing Then
            Found.Interior.Color = vbYellow
        End If
    Set Found = Nothing
Next i

End Sub

这篇关于从工作簿中的多个工作表中查找重复项的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！