2016-05-12 3 views
1

Я пытаюсь остановить дубликаты записей в нескольких столбцах из раскрывающегося списка. Я работаю для первого столбца, но когда я пытаюсь добавить диапазон для столбцов C2: C9, D2: D9 и E2: E9, я получаю ошибки. Это код, который у меня есть для B2: B9, может ли кто-нибудь сказать мне, как добавить больше диапазонов? Каждый столбец использует тот же список для записей. Это простой список чисел с 1 по 8. Я хочу, чтобы каждый столбец мог забить от 1 до 8, не дублируя счет в отдельном столбце.Как добавить несколько диапазонов в excel, чтобы предотвратить дублирование записей

Private Sub Worksheet_Change(ByVal Target As Range) 
If Intersect(Target, Range("B2:B9")) Is Nothing Then Exit Sub 
If Target.Cells.Count > 1 Then Exit Sub 
If WorksheetFunction.CountIf(Range("B2:B9"), Target) > 1 Then 
Application.EnableEvents = False 
Application.Undo 
Application.EnableEvents = True 
MsgBox "Duplicate score. Please select a different value." 
End If 
End Sub 

Спасибо

+0

Вы пытались использовать 'Target.Column'? – Brian

ответ

0

Попробуйте это:

Private Sub Worksheet_Change(ByVal Target As Range) 

If Intersect(Target, Range(Cells(2, Target.Column), Cells(9, Target.Column))) Is Nothing Then Exit Sub 
If Target.Cells.Count > 1 Then Exit Sub 

If WorksheetFunction.CountIf(Range(Cells(2, Target.Column), Cells(9, Target.Column)), Target) > 1 Then 
    Application.EnableEvents = False 
    Application.Undo 
    Application.EnableEvents = True 
    MsgBox "Duplicate score. Please select a different value." 
End If 

End Sub 

Это будет работать для любого столбца в строках 2: 9.

+0

Это здорово! Большое вам спасибо, он отлично работает! –

+0

@HiResCovers Нет проблем! Не могли бы вы отметить как ответ? – Brian

0

Рассмотрим:

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim r As Range 

    Set r = Range("B2:E9") 
    If Intersect(Target, r) Is Nothing Then Exit Sub 
    If Target.Cells.Count > 1 Then Exit Sub 
    If WorksheetFunction.CountIf(r, Target) > 1 Then 
     Application.EnableEvents = False 
      Application.Undo 
     Application.EnableEvents = True 
     MsgBox "Duplicate score. Please select a different value." 
    End If 
End Sub 

код будет немного отличаться, если столбцы были не пересекаются.

Смежные вопросы