Текущий код VBA копируется в зависимости от условия, но дублирует предыдущие данные при каждом запуске

Question

По сути, я новичок в любом виде кодирования, и я могу вводить письменные коды и выяснять, что мне нужно изменить, но у меня все равно есть необходимость писать что-то новое.

У меня есть таблица Excel, которую мы хранимотслеживание принятия в программу и отклонения.Мне нужно отслеживать отклонения на втором листе, чтобы они все были в одной области.

Я нашел код VBA для Excel, который успешно копирует требуемую информацию с одного листа на основе значения на второй лист.Поэтому, когда я выбираю «отклонено» и запускаю код, он копирует все данные на второй лист.Он прекрасно работает с одним предупреждением, каждый раз, когда я запускаю код, он извлекает новые данные и ранее скопированные данные.

Я хотел бы добавить к коду VBA, чтобы либо не копировать ранее скопированные данные, либо найти код, который автоматически удаляет дубликаты.

Так что я оглянулся вокруг, чтобы посмотреть, смогу ли я найти несколько кодов VBA для дуппинга, и я попробовал несколько, но оригинальный код не работал хорошо, и я получил некоторые ошибки.У меня был один, который выглядел действительно хорошо, но, похоже, он плохо сочетается с оригинальным кодом.

Ниже приведен текущий код, который работает для копирования отклоненного.

Private Sub CommandButton1_Click()

a = Worksheets("ARD2019").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a
If Worksheets("ARD2019").Cells(i, 2).Value = "Rejected" Then
    Worksheets("ARD2019").Rows(i).Copy
    Worksheets("Rejected").Activate
    b = Worksheets("Rejected").Cells(Rows.Count, 1).End(xlUp).Row
    Worksheets("Rejected").Cells(b + 1, 1).Select
    ActiveSheet.Paste
    Worksheets("ARD2019").Activate

End If
Next

Application.CutCopyMode = False

Я надеюсь, что мне не нужно говорить людям, использующим программу, просто вручную запустить функцию дедупликации Excel, но если нереально написать код поверх кода выше,я не думаю, что они будут жаловаться, так как это все еще лучше, чем то, что они делали ранее, который вручную копировал строки.

Answer 1

Предположим, что столбец A имеет уникальные ключи на обоих листах. Ниже приведен простой способ начать:

Option Explicit

Private Sub CommandButton1_Click()

    Dim LastRowSour As Long, LastRowDest As Long, Row As Long
    Dim wsSou As Worksheet, wsDes As Worksheet

    'Set worksheets
    With ThisWorkbook
        Set wsSou = .Worksheets("ARD2019")
        Set wsDes = .Worksheets("Rejected")
    End With

    'Find the last row of column A of wsSou
    LastRowSour = wsSou.Cells(wsSou.Rows.Count, "A").End(xlUp).Row

    'Loop start from row 2 to LastRowSour
    For Row = 2 To LastRowSour

        'Find the last row of column A of wsDes
        LastRowDest = wsDes.Cells(wsDes.Rows.Count, "A").End(xlUp).Row

        'Chek if .Cells(Row, 2).Value is reject & wsSou.Cells(Row, 1).Value is not appear in the first column of wsDes
        If wsSou.Cells(Row, 2).Value = "Rejected" And Application.CountIf(wsDes.Range(wsDes.Cells(1, 1), wsDes.Cells(LastRowDest, 1)), wsSou.Cells(Row, 1).Value) = 0 Then

            wsSou.Rows(Row).Copy

            wsDes.Range("A" & LastRowDest + 1).PasteSpecial xlPasteValues

        End If

    Next

    Application.CutCopyMode = False

End Sub