Как проверить наличие дубликатов и отобразить счетчик MsgBox - PullRequest
Новая
       33

Как проверить наличие дубликатов и отобразить счетчик MsgBox

0 голосов
/ 21 февраля 2020

У меня есть три рабочих листа, и, по сути, я хочу выбрать ячейку в столбце А листа 2 (в качестве активной ячейки) и проверить, есть ли дубликаты в столбце А листа 3 (диапазон для этого листа должен быть от A1 к последней строке данных).

Если есть дубликаты, я бы хотел, чтобы в msgbox отображалось количество дублирующихся значений, если оно больше 3.

Я добавил комментарии, поясняющие мой лог c на каждом шаге, пожалуйста, не стесняйтесь также упростить мой код: 

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 и просто переходит к Завершить 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/

1 Ответ

0 голосов
/ 24 февраля 2020

Вот окончательный код, который я использую для всех, кто использует этот вопрос в качестве справочного материала для своих вопросов: 

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
...