在 colA 上的 Excel VBA 标记重复（所有工作表上的工作包括活动表）

Question

我想在工作簿中的所有工作表上标记重复。只有在其他工作表上存在重复项时，代码标记下方才会重复。 如果它们存在于 Activesheet 上，我也想标记它们。 （如果重复只存在于 Activesheet 中，如果可以用不同的颜色标记会更好）

这是类似案例的解决方案链接，我需要解决的问题。 [a link](https://stackoverflow.com/a/25252503/5493335) "循环遍历工作表中 Col A 的值，该值被激活，然后搜索所有剩余工作表的 Col A，如果找到 ID，则将单元格背景着色为红色。由悉达特·劳特"

我只对该代码添加了一项更改以消除空行上的颜色。 但是只有当重复是另一个工作表时，这些代码才被标记（红色）。 如果我在活动工作表上发现重复，我想知道是否可以使用不同的颜色。

我会尝试做自己并用 else 改变条件，但它不起作用。谁能帮我解决这个问题。

提前致谢。

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
                if strSearch <> "" then 'eliminated color empty cell

                '~~> 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
                   End if 
            Next i
        End With
    End Sub

Answer 1

我将对您的代码进行以下重构：

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim IDsRng As Range, IDCell As Range
    Dim ws As Worksheet
    Dim strSearch As String
    Dim foundInOtherSheet As Boolean, foundInActiveSheet As Boolean

    With Sh
        Set IDsRng = .Range("A1", .Cells(.Rows.count, 1).End(xlUp)) '<--| set the IDs range as all column A not empty cells with some "text" content
        '~~> 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
    End With


    For Each IDCell In IDsRng '<--| Loop through ID cells (i.e. column A "text" cells of the activated sheet)
        '~~> Store the ID in a variable
        strSearch = IDCell.Value

        foundInActiveSheet = WorksheetFunction.CountIf(IDsRng, strSearch) > 1 '<--| count possible dupes in active sheet
        foundInOtherSheet = False '<--| initialize it at every new ID

        '~~> 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
                With ws
                    foundInOtherSheet = WorksheetFunction.CountIf(.Range("A1", .Cells(.Rows.count, 1).End(xlUp)), strSearch) > 1
                    If foundInOtherSheet Then Exit For '~~> If found then color then no point searching rest of the sheets
                End With
            End If
        Next

        Select Case True '<--| now act accordingly to where duplicates have been found
            Case foundInOtherSheet And Not foundInActiveSheet '<--| if duplicates found in "other" sheets only
                IDCell.Interior.ColorIndex = 3 '<--| red
            Case foundInOtherSheet And foundInActiveSheet '<--| if duplicates found in "other" sheets and in "active" one too
                IDCell.Interior.ColorIndex = 6 '<--| yellow
            Case Not foundInOtherSheet And foundInActiveSheet '<--| if duplicates found in "active" sheets only
                IDCell.Interior.ColorIndex = 14 '<--| green
        End Select

    Next
End Sub

Answer 2

把If ws.Name <> Sh.NameThen线和end if下面的线去掉。