☰

Как проверить наличие повторяющихся значений в Excel vba?

tag-icon • tag-icon microsoft-excel vba macros
Как проверить наличие повторяющихся значений в Excel vba?

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

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

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

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
  Dim rngCell As Range Dim lngLstRow As Long lngLstRow = Sheet1.UsedRange.Rows.Count
  For Each rngCell In Sheet1.Range("A1:A" & lngLstRow) 
    If CountIf(Range("A:A"),A1) > 2 Then
      MsgBox "Please enter unique value " & rngCell.Address
        rngCell.Select
    End If 
  Next 
End Sub

решение1

Используя Changeсобытие, мы можем перехватывать дублирующие записи без проверки данных:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim RangeOfInterest As Range, Intersection As Range, cell As Range
    
    Set RangeOfInterest = Range("A:A")
    Set Intersection = Intersect(RangeOfInterest, Target)
    If Intersection Is Nothing Then Exit Sub
    
    With Application
        For Each cell In Intersection
            If .WorksheetFunction.CountIf(RangeOfInterest, cell.Value) > 1 Then
                .EnableEvents = False
                    .Undo
                .EnableEvents = True
                MsgBox "duplicates not allowed"
            Exit Sub
            End If
        Next cell
    End With
End Sub

ПРИМЕЧАНИЕ:

  1. код может обрабатывать как типизированные записи в столбцеАа также копировать/вставлять в столбец
  2. код может обрабатывать копирование/вставку нескольких ячеек в столбец

Связанный контент