重複チェック

質問

あるシートに値を入れた時、そのシートのA1：Z80の範囲内で重複する値が既存するかどうか調べたいです。
下記のコードを試すと、どの値を入れても既存すると帰ってきます。
入力した値自身を見つけて重複だと言っている気がするのですが、どのように対処すればいいのか教えてほしいです。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
For Each myCell In Sheets("居場所").Cells

If Target.Value = myCell.Value Then
MsgBox "この名前は既に存在しています。", vbOKOnly + vbExclamation
Exit Sub

If myCell.Address = "$Z$80" Then Exit Sub
End If

Next
End Sub

回答No.2

okormazd · ベストアンサー

ANo.1
です。
このままではどこに入力しても同じだね。
1.コードの順序を変える。
2.入力したセルを検索から避ける。
だね。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
For Each myCell In Sheets(1).Cells
If myCell.Address = "$Z$80" Then Exit Sub'位置はここ
If myCell.Address <> Target.Address Then'これを追加
If Target.Value = myCell.Value Then
MsgBox "この名前は既に存在しています。", vbOKOnly + vbExclamation
Exit Sub
End If
End If'これを追加
Next
End Sub

補足は見てない。

お礼

なるほど、コードの順番でだいぶ変わるんですね。
重複チェックは無事解決しました！
他の問題点はもう少し考えてみます。

ありがとうございました。

回答No.4

zap35

もし値を入力するセル範囲がA1:Z80の中であれば、これだけでも良いと思います。For Each～Next文よりは高速に処理できます。

Private Sub Worksheet_Change(ByVal Target As Range)
　　If Application.CountIf(Range("A1:Z80"), Target.Value) > 1 Then
　　　　MsgBox Target.Value & "は既に入力されています"
　　End If
End Sub

A1:Z80の範囲外に入力する可能性があるなら以下です。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
　　Set rng = Intersect(Target, Range("A1:Z80"))
　　If rng Is Nothing Then
　　　　If Application.CountIf(Range("A1:Z80"), Target.Value) > 0 Then
　　　　　　MsgBox Target.Value & "は既に入力されています"
　　　　End If
　　Else
　　　　If Application.CountIf(Range("A1:Z80"), Target.Value) > 1 Then
　　　　　　MsgBox Target.Value & "は既に入力されています"
　　　　End If
　　End If
End Sub

お礼

同じ結果を得るにもさまざまな方法があるんですね。
これも試してみます。勉強になりました。
ありがとうございました！

回答No.3

okormazd

ANo.1
です。
sheet名が変わっているので、直して。

回答No.1

okormazd

このコードではA1：Z80の範囲に入力すると、必ず、
"この名前は既に存在しています。"といってくる。
「入力した値自身を見つけて重複だと言っている」んです。
入力はどこのセルにしていますか。

お礼

回答ありがとうございます。

特定のセルは決めたくないのです。
セル範囲A1：Z80の何処かに入力した時、
セル範囲A1：Z80の入力したセル以外の場所に同じ値が入っているかどうか調べたいです。

補足

質問のコードでは重複の有無を確認するだけですが、
それが可能になったら、入力した値を他の二つのシート（"データ1""データ"）の表からMATCHで探し、帰ってきた行番号の値を使ってハイパーリンクを設置する予定です。
ハイパーリンクの設定でセルの位置を指定する方法もわからず、もしよろしければその部分の間違いを正すためのヒントもいただけないでしょうか。

Dim doumeikennsaku, y, z
Set y = Worksheets("データ1").Range("$C$4:$C$1003")
Set z = Worksheets("データ").Range("$A$2:$A$65536")
doumeikennsaku = Application.Match(Target.Value, y, 0)
If IsNumeric(doumeikennsaku) Then
Worksheets("居場所").Hyperlinks.Add anchor:=Target, Address:="", sbaddress:="'" & データ1 & "'!range(cells(doumeikennsaku,3))"
Else
doumeikennsaku = Application.Match(Target.Value, z, 0)
If IsError(doumeikennsaku) Then
MsgBox "見つからないのでリンクは貼りません", vbOKOnly + vbExclamation
Exit Sub
Else
Worksheets("居場所").Hyperlinks.Add anchor:=Target, Address:="", SubAddress:="'" & データ & "'!range(cells(doumeikennsaku,1))"