Question

我想在工作簿中的所有工作表上标记重复。如果副本存在于其他工作表中，则代码标记下方仅重复。如果它们存在于Activesheet中，我也想标记它们。（如果可以在不同的颜色上标记，如果重复只存在于活动表中，那就更好了）

这是一个解决类似案例的链接，我需要解决的问题。 [链接]（https://stackoverflow.com/a/25252503/5493335）＆＃34;循环播放工作表中的Col A值，然后搜索所有剩余工作表的Col A，如果找到ID，则会对其进行着色细胞背景为红色。作者：Siddhart Rout＆＃34;

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

我会努力做自己并改变其他条件，但它不起作用。任何人都可以帮我解决这个问题。

提前致谢。

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

删除下面的If ws.Name <> Sh.Name然后行和end if。

Answer 2

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

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

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

2 个答案: