Выявление дубликатов при копировании / вставке нескольких ячеек в столбец Excel

Question

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

Я нашел этот код, но он работает, только если я копирую вставку по одному значению за раз.

Есть ли способ заставить его работать так, чтобы он вставлял только уникальные скопированные значения, которых еще нет в столбце?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

''''''''''''''''''''''''''''''''''''''''''
'Prevents duplicate entries in Column A
''''''''''''''''''''''''''''''''''''''''''


    If Target.Cells.Count > 1 Then Exit Sub

    If Target.Column = 1 And Target <> vbNullString Then                           'Column A
        If WorksheetFunction.CountIf(Columns(1), Target) > 1 Then
            MsgBox "Entry " & Target & " already exists!", _
                vbCritical, "Dixons Travel Oslo"
            Target = ""
            Target.Select
        End If
    End If

End Sub

Answer 1

Может быть, вы найдете это полезным:

В приведенном ниже коде предполагается, что вы просто копируете все значения, даже если они уже существуют.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 1 Then
    Range("A1", Range("A1").End(xlDown)).RemoveDuplicates Columns:=1, Header:=xlNo
End If

End Sub

Это будет выглядеть так:

Измените Header:=xlNo на Header:=xlYes, если это относится к вашей ситуации.

Очевидно, есть и другие способы. Я просто нахожу это довольно простым.

Answer 2

Используя методологию, аналогичную существующей, вы можете сделать следующее:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Application.EnableEvents = False
    For Each tcell In Target.Cells
        With tcell
        If .Column = 1 And .Value <> vbNullString Then     'Column A
            If WorksheetFunction.CountIf(Columns(1), .Value) > 1 Then
                tcell.Value = ""
            End If
        End If
        End With
    Next
    Application.EnableEvents = True
End Sub

---

Вот еще один способ - расширить и улучшить идею JvdV:

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target.Parent
        If Not (Intersect(Target, .Columns(1)) Is Nothing) Then
            Range("A1", Range("A" & .Rows.Count).End(xlUp)).RemoveDuplicates Columns:=1, Header:=xlNo
        End If
    End With
End Sub

Это позволяет вставлять несколько ячеек - независимо от того, сколько столбцов затронуто и устраняет дублирование целого столбца A.

Answer 3

Вы можете попробовать:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Target.Column = 1 Then
        Application.EnableEvents = False
            ThisWorkbook.Worksheets("Sheet1").Columns("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
        Application.EnableEvents = True
    End If

End Sub

Примечания:

• Вы можете изменить имя листа
• Опция заголовка