excel - 突出显示整个工作簿中的重复项

Question

我试图在 12 张工作簿中突出显示重复项。

我们跟踪 ID#，如果 ID#(值)在任何其他工作表上，我想突出显示该单元格。

当我在“本工作簿”中使用以下代码时，它适用于一个工作表，而不是跨多个工作表。

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim Rng As Range
Dim cel As Range
Dim col As Range
Dim c As Range
Dim firstAddress As String

'Duplicates will be highlighted in red
Target.Interior.ColorIndex = xlNone
For Each col In Target.Columns
    Set Rng = Range(Cells(1, col.Column), Cells(Rows.Count, col.Column).End(xlUp))
    Debug.Print Rng.Address

    For Each cel In col
        If WorksheetFunction.CountIf(Rng, cel.Value) > 1 Then
            Set c = Rng.Find(What:=cel.Value, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Interior.ColorIndex = 3
                    Set c = Rng.FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End If
    Next
Next col

Answer 1

此代码的作用是循环遍历激活的工作表中的 Col A 值，然后搜索所有剩余工作表的 Col A，如果找到 ID，则将单元格背景着色为红色。

久经考验

我已经对代码进行了注释，因此您理解它应该没有问题。如果您仍然这样做，那么只需回发 :)

试试这个

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim lRow As Long, wsLRow As Long, i As Long
    Dim aCell As Range
    Dim ws As Worksheet
    Dim strSearch As String

    With Sh
        '~~> Get last row in Col A of the sheet
        '~~> which got activated
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Remove existing Color from the column
        '~~> This is to cater for any deletions in the
        '~~> other sheets so that cells can be re-colored
        .Columns(1).Interior.ColorIndex = xlNone

        '~~> Loop through the cells of the sheet which
        '~~> got activated
        For i = 1 To lRow
            '~~> Store the ID in a variable
            strSearch = .Range("A" & i).Value

            '~~> loop through the worksheets in the workbook
            For Each ws In ThisWorkbook.Worksheets
                '~~> This is to ensure that it doesn't
                '~~> search itself
                If ws.Name <> Sh.Name Then
                    '~~> Get last row in Col A of the sheet
                    wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

                    '~~> Use .Find to quick check for the duplicate
                    Set aCell = ws.Range("A1:A" & wsLRow).Find(What:=strSearch, _
                                                               LookIn:=xlValues, _
                                                               LookAt:=xlWhole, _
                                                               SearchOrder:=xlByRows, _
                                                               SearchDirection:=xlNext, _
                                                               MatchCase:=False, _
                                                               SearchFormat:=False)

                    '~~> If found then color the cell red and exit the loop
                    '~~> No point searching rest of the sheets
                    If Not aCell Is Nothing Then
                        Sh.Range("A" & i).Interior.ColorIndex = 3
                        Exit For
                    End If
                End If
            Next ws
        Next i
    End With
End Sub