Excel VBA在colA上标记重复（在所有工作表上工作包括活动表单） [英] Excel VBA mark duplicate on colA (work on all worksheet include activesheet)

问题描述

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

I'd like to mark duplicate on all Worksheet in Workbook. Below the code mark only duplicate if the duplicate exist on other worksheet. I'd like to mark them also if them exist on Activesheet. (much better if it possible to mark on different color if duplicate exist only in Activesheet)

这是一个关于类似案例的解决方案的链接，我需要什么解决。 [a link]（ https://stackoverflow.com/a/25252503/5493335 ）循环了Col的值A在表格中被激活，然后在所有剩余的工作表中搜索Col A，如果它找到ID，那么它将单元格背景颜色变成红色。由Siddhart Rout

Here's a link for solution on similar case, What I need to solve. [a link](https://stackoverflow.com/a/25252503/5493335) "loops through the values of Col A in the sheet which gets activated and then it searches the Col A of all the remaining worksheets and if it finds the ID then it colors the cell background to red. by Siddhart Rout"

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

I add only one change to this code to eliminate color on empty rows. But those code is mark(on red color) only if duplicate is one another Worksheet. I wonder to makr on diffrent color if I found duplicate on activeworksheet.

我将尝试用自己来改变条件，但是它不会工作。任何人都可以帮我解决这个问题。

I will trying to do myself and change the condition with else but It doesn't work. Could anybody get me some help to solve that issue.

提前感谢。

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

推荐答案

我会用以下代码重构：

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

这篇关于Excel VBA在colA上标记重复（在所有工作表上工作包括活动表单）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！