如何在Excel中添加多个范围，以防止重复条目

我试图从下拉列表中停止几列中的重复条目。 我有它的第一列工作，但是当我尝试添加列C2：C9，D2：D9和E2：E9的范围我得到错误。 这是B2：B9的代码，谁能告诉我如何添加更多的范围？ 每列使用相同的列表作为条目。 这是一个简单的数字1到8的列表。我希望每列能够得分1到8，而不重复在单个列中的分数。

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 

谢谢

Answer 1

尝试这个：

 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中的任何列。

Answer 2

考虑：

 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 

如果列是不相交的，代码会稍微有些不同。