複数の範囲をExcelに追加すると、重複するエントリを防ぐことができます

Question

複数の列に重複したエントリをドロップダウンリストから停止しようとしています。私は最初の列のために働いているが、列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 

列がばらばらだった場合、コードが若干異なるだろう。