エクセルで重複データを表示

現在エクセルで名簿を作成しているのですが名簿が重複している場合に下記のような動作をさせることができないか悩んでおります。ご存じの方いましたらご回答よろしくお願いします。

A列（氏名）B列（住所）
A列に氏名を入力していった時に同じ名前が既に入力されたいたら
すでに入力されている場所にカーソルが移動し「重複の確認メッセージを表示」その際に同姓同名の別人の場合で入力継続の場合は「元の場所にカーソルを戻す」同一人物の場合は入力したデータを「削除しカーソルはそのままの場所を保持する」ようにしたいのです。よろしくお願いします。

No.1 ベストアンサー 回答者： ham_kamo 回答日時： 2007/04/04 10:10

別人の場合は「元の場所にカーソルを戻す」けど、同一人物の場合は戻さない、ということでよろしいですか？（重複した名前にカーソルが飛んで、そのままの場所を保持、ということでしょうか）

シートタブを右クリックして「コードの表示」を選択すると、VBAの画面が出るので、その画面の右側に以下のマクロをコピーして貼り付けてください。

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim T As Range, R As Range
　Set T = Target.Cells(1, 1)
　If T.Column <> 1 Or T.Value = "" Then Exit Sub
　Set R = Range("A:A").Find(What:=T.Value, LookAt:=xlWhole)
　If R.Row = T.Row Then Exit Sub
　R.Select
　If MsgBox("同姓同名の名前が既に入力されています。" & vbCrLf & _
　"別人ならOKを、同じ人の場合はキャンセルを押してください", _
　vbOKCancel, "重複あり") = vbCancel Then
　　Application.EnableEvents = False
　　T.ClearContents
　　Application.EnableEvents = True
　Else
　　T.Select
　End If
End Sub

貼り付けたらVBAの画面は閉じてかまいません。A列に氏名を入力したときに、同じ名前が既にあったらダイアログが出ます。OKを押すと別人とみなして選択セルを戻し、キャンセルを押すと入力した名前は消して、選択セルはその位置のままになります。

希望した動作と異なったり、何か不具合があれば補足をお願いします。

この回答への補足

早速試してみたのですが以下の点がうまく動きません。
ご教示よろしくお願いします
1.教えていただいた物をコピペした時、A1に最初に文字を入力してしまうと動かない（A1に数値を入力しておけば以後は文字でも動く）
2.実際に入力するのはC列なのですがRange("A:A").をRange("C:C").に
変更しても動かない。

以上よろしくお願いします

補足日時：2007/04/04 15:00

この回答へのお礼

早速のご回答ありがとうございました。さっそく試してみたいと思います＾＾

お礼日時：2007/04/04 11:31

No.4 回答者： ham_kamo 回答日時： 2007/04/04 18:41

No.3です。

すみません、ちゃんと書くべきでした。
Set R = Range("A:A").Find(What:=T.Value, LookAt:=xlWhole)
の行も
Set R = Range("C:C").Find(What:=T.Value, LookAt:=xlWhole)
に変えてください。

No.3 回答者： ham_kamo 回答日時： 2007/04/04 15:46

No.1です。

実際に氏名を入力するのはＣ列なのですね。それなら、上から４行目の
　If T.Column <> 1 Or T.Value = "" Then Exit Sub
を
　If T.Column <> 3 Or T.Value = "" Then Exit Sub
に変えてください。

この回答への補足

お忙しい中本当にありがとうございます。
現在白紙のワークシートに教えていただいたコード
Private Sub Worksheet_Change(ByVal Target As Range)
Dim T As Range, R As Range
Set T = Target.Cells(1, 1)
If T.Column <> 3 Or T.Value = "" Then Exit Sub
Set R = Range("A:A").Find(What:=T.Value, LookAt:=xlWhole)
If R.Row = T.Row Then Exit Sub
R.Select
If MsgBox("同姓同名の名前が既に入力されています。" & vbCrLf & _
"別人ならOKを、同じ人の場合はキャンセルを押してください", _
vbOKCancel, "重複あり") = vbCancel Then
Application.EnableEvents = False
T.ClearContents
Application.EnableEvents = True
Else
T.Select
End If
End Sub
を張り付けたのですが
実行時エラー91
オブジェクト変数またはwithブロック変数が設定されていません。
と表示され（6行目の「If R.Row = T.Row Then」がハイライト表示）
正常に動作しません。ご教示よろしくお願いします。

補足日時：2007/04/04 18:05

No.2 回答者： meron_ 回答日時： 2007/04/04 10:24

あっちこっち移動するのはかえってややこしいかと。

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Target.Column = 1 Then Exit Sub
If Target.Count <> 1 Then Exit Sub

strName = Target.Value

'同じ値の個数
intr = Application.WorksheetFunction.CountIf(Range("A1:A9999"), Target.Value)

If intr > 1 Then
Set fr = ActiveSheet.Columns(1).Find(strName)
msg = strName & " は既に存在します。" & vbLf & vbLf & _
" " & fr.Address & " " & fr.Value & " " & fr.Offset(, 1).Value & vbLf & vbLf & _
"このまま入力を継続する場合は、[ＯＫ]　を" & vbCrLf & _
"入力した値を削除する場合は、 [キャンセル]　をクリックして下さい。"
Title = "重複の確認"
param = vbOKCancel + vbExclamation + vbDefaultButton1 + vbApplicationModal
ans = MsgBox(msg, param, Title)
Select Case ans
Case 1 '「OK」ボタンの場合
MsgBox "入力を続行してください"

Case 2 '「キャンセル」ボタンの場合
Target.ClearContents
MsgBox strName & " の入力をキャンセルしました。"

End Select

End If

Set fr = Nothing

End Sub

この回答へのお礼

早速のご回答ありがとうございました。さっそく試してみたいと思います＾＾

お礼日時：2007/04/04 11:31