如何检查重复项并显示计数 MsgBox

Question

我有三个工作表，基本上我想 select Sheet 2 的 A 列中的一个单元格（作为活动单元格）并检查 [=A 列中是否有重复项 Sheet 3（这个 Sheet 的范围应该是从 A1 到数据的最后一行）。

如果有任何重复，我希望一个消息框显示重复值的数量，如果它大于 3。

我在每一步都添加了注释来解释我的逻辑，请随时简化我的代码：

Sub Check_Duplicates()


    'Declaring variables
    Dim Cell As Variant
    Dim Source As Range
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim rowAC As Long
    Dim Counter As Long

    'Assigning a worksheet to the decalred variables
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set sh3 = Sheet3

    'Sets the Long variable as the Active Cell Row in Sheet 2
    rowAC = ActiveCell.Row

    'Initializing "Source" variable range to last row in Sheet 3
    Set Source = sh3.Range("A1", sh3.Range("A1").End(xlDown)) 

    'Looping through each cell in the "Source" variable Range
    For Each Cell In Source

        'Checking if the "Cell" values in Sheet 3 (in column A to the last row) are equal to the value in the Active Cell in Column A
        If Cell.Value = sh2.Range("A" & rowAC).Value Then

            'Checking whether the value in "Cell" already exists in the "Source" range
            If Application.WorksheetFunction.CountIf(Source, Cell) > 1 Then

                'Counts and stores the number of duplicate values from Sheet 3 "Cells" compared to the Active Cell value in Sheet 1 Column A
                Counter = Application.WorksheetFunction.CountIf(sh3.Range("Source,Cell"), sh2.Range("A" & rowAC))

                'If there are more than 3 duplicates then display a message box
                If Counter > 3 Then

                    'Msgbox displaying the number of duplicate values in Sheet 3
                    MsgBox "No. of duplicates is:" & Counter

                End If

            End If

        End If

    Next

End Sub

目前，我的代码到达第一个 IF 语句 并简单地转到 End IF，因此它不会执行过去这一行并简单地转到 Next 然后 End Sub： If Cell.Value = sh2.Range("A" & rowAC) .Value Then

交叉引用： https://www.mrexcel.com/board/threads/how-to-check-for-duplicates-and-display-a-count-msgbox.1125070/

Answer 1

这是我为使用此问题作为其问题参考的任何人使用的最终代码：

Sub Check_Duplicates()
    'Declaring variables
    Dim Source As Range
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim rowAC As Long, Counter As Long

    'Assigning a worksheet to the decalred variables
    Set sh1 = Sheet1
    Set sh2 = Sheet2
    Set sh3 = Sheet3

    'Sets the Long variable as the Active Cell Row in Sheet 2
    rowAC = ActiveCell.Row

    'Initializing "Source" variable range to last row in Sheet 3
    Set Source = sh3.Range("A1", sh3.Range("A" & Rows.Count).End(xlUp))

    'count number of times is in Source range
    Counter = Application.WorksheetFunction.CountIf(Source, sh2.Range("A" & rowAC))

    'If there are more than 3 duplicates then display a message box
    If Counter > 3 Then
        'Msgbox displaying the number of duplicate values in Sheet 3
        MsgBox "No. of duplicates is: " & Counter
    End If
End Sub

如何检查重复项并显示计数 MsgBox

How to Check for Duplicates and Display a Count MsgBox

excel

vba

counter

duplicates