Excelで縦の重複値を検出するには

お仕事で必要だったのでメモ。

VBEditer開いて、機能を実装したいシートで以下のコードを記述

Private Sub Worksheet_Change(ByVal Target As Range)

    '配列だったら Exit Sub
    If IsArray(Target.Cells.Value) Then Exit Sub
    '空だったら Exit Sub
    If IsEmpty(Target.Cells.Value) Then Exit Sub

    Column = Target.Cells.Column
    If Application.WorksheetFunction.CountIf(Range(Cells(1, Column), Cells(Rows.Count, Column)), Target.Value) > 1 Then
        MsgBox "入力値が重複しています", vbCritical, "重複検出"
        Target.Cells.Value = Null
        Target.Cells.Select
    End If
    
End Sub

重複する値が入ったらメッセージボックスで怒ってくれる

（2012/4/2 修正）

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Col As Integer
    Dim v As Object
    
    Const colMax = 10
    
    '空だったら Exit Sub
    If IsEmpty(Target.Cells.Value) Then Exit Sub
    'チェック対象列限界を超えてたらExit Sub
    If Target.Cells.Column > colMax Then Exit Sub

    ''''''''''''''''''''''''''
    '' ここからチェック対象 ''
    ''''''''''''''''''''''''''
    '配列だったら 各セルをチェックし、重複分は未入力に戻す
    If IsArray(Target.Cells.Value) Then
        For Each v In Target.Cells
            If Application.WorksheetFunction.CountIf(Range(Cells(1, v.Column), Cells(Rows.Count, v.Column)), v.Value) > 1 Then
                MsgBox "入力値が重複しています", vbCritical, "重複検出"
                v.Value = Null
            End If
        Next v
    Else
    '1つのセルの変更時は直接値を確認し、重複時は未入力に戻す
        Col = Target.Cells.Column
        If Application.WorksheetFunction.CountIf(Range(Cells(1, Col), Cells(Rows.Count, Col)), Target.Value) > 1 Then
            MsgBox "入力値が重複しています", vbCritical, "重複検出"
            Target.Cells.Value = Null
            Target.Cells.Select
        End If
    End If
    
End Sub