Избегайте вставки повторяющегося набора значений в столбец в Excel

Question

Я работаю над базой c, но как-то не могу ее взломать

Мне нужно разработать простой макрос с использованием VB-скрипта в Excel, который может помешать пользователям вставлять заданные значения, в которых есть дубликаты.

Например, в столбце A Excel, если кто-то пытается скопировать следующее:

    cat  
    mat  
    rat  
    cat

Ошибка должна быть выдана с сообщением:

" Попытка вставить дублирующее значение "

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

    Sub Highlight_Duplicates(Values As Range)
    Dim Cell

    For Each Cell In Values
      If WorksheetFunction.CountIf(Values, Cell.Value) > 1 Then
        MsgBox "Duplicate Value"
    End If

  Next Cell
 End Sub

Private Sub Auto_Load()

 Highlight_Duplicates (Sheets("Sheet1").Range("A1:A10"))

End Sub  

Но я не могу ограничить пользователя от вставки набора значения.

Просьба сообщить.

Answer 1

Вы можете использовать Worksheet_Change() событие Application.Undo

На кодовой странице рабочего листа, для которой вы хотите отслеживать это действие / событие, вы можете сделать что-то вроде:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Test if it's the column we want. Test that only one thing was pasted.
    If Not Intersect(Target, Range("A:A")) Is Nothing And Target.Cells.Count = 1 Then
        'Test to see how many times this value is in use.
        'If greater than one, then undo the paste and yell at the user
        If Application.WorksheetFunction.CountIf(Range("A:A"), Target.Value) > 1 Then
            Application.Undo
            MsgBox ("The value " & Target.Value & " is already present")
        End If
    End If
End Sub

One Один из способов справиться с несколькими вставленными значениями: Private Sub Worksheet_Change (ByVal Target As Range) 'Проверить, какой столбец нам нужен. Проверьте, что была вставлена ​​только одна вещь. Если не пересекаются (цель, диапазон («A: A»)) - ничто, то

        'Loop through each cell in the target range (as multiple may have been pasted)
        Dim TargetCell as Range
        For each TargetCell in Target.Cells

            'Test to see how many times this value is in use.
            'If greater than one, then undo the paste and yell at the user
            If Application.WorksheetFunction.CountIf(Range("A:A"), TargetCell.Value) > 1 Then
                Application.Undo
                MsgBox ("The values pasted contained at least one duplicate. Duplicate found:" & TargetCell.Value)
                Exit For
            End If
        Next TargetCell
    End If
End Sub

Это должно послужить хорошим началом для начала и может быть настроено для выполнения любых действий.