重複した値をチェックするには…

質問

シート1からシート10まであるブックがあります。
各シートのE2セルには氏名が入ります。
入力はシート1から順番にしていくとします。
どのシートまで入力するかは一定ではありませんが
最高10番目のシートまでということです。

たとえば、シート1のE2に入力された値が佐藤だとして、
シート2のE2に入力された値が鈴木だとします。
次にシート3のE2に入力された値がまた佐藤だった場合
シート3に入力した値を変更するように促すメッセージを出したいのです。
ただ入力できないようにするのではなく
修正が出来るようにしたいのが希望です。

入力規則でもなんとかなるのかと思いましたが
シートをまたいだやり方がわかりません。

よろしくお願いします。

回答No.3

fumufumu_2006 · ベストアンサー

>For シート数 = 2 To 10
>Sheets("購入者" & シート数).Name = Range("E2")
>Next シート数

をしたいだけなら、前もって同名の個数を調べるという方法もありますが・・・
（ちなみに、変更前には、"購入者2","購入者3"..."購入者10"と言うシートがあるんですよね）
それと、
>どのシートまで入力するかは一定ではありませんが
とあるので、入力の無いシートは変更しません。

Dim シート数 As Integer
Dim n(10) As Integer
Dim i As Integer

For シート数 = 2 To 10
'自分より前に何個同じ名前があるか調べて配列に入れておく
For i = 2 To シート数 - 1
If Sheets("購入者" & i).Range("E2") = Sheets("購入者" & シート数).Range("E2") Then
n(シート数) = n(シート数) + 1
End If
Next
Next シート数

'これから名前を変更
For シート数 = 2 To 10
If Sheets("購入者" & シート数).Range("E2") <> "" Then '入力のあるシートだけ
If n(シート数) = 0 Then
'同名が無い場合は、そのシートのE2
Sheets("購入者" & シート数).Name = Sheets("購入者" & シート数).Range("E2")
Else
'同名があった場合は、そのシートのE2 & 同名数＋1
Sheets("購入者" & シート数).Name = Sheets("購入者" & シート数).Range("E2") & (n(シート数) + 1)
End If
End If
Next

名前を変更する部分をiifを使って1行で済ませる方法もあります・・・
For シート数 = 2 To 10
If Sheets("購入者" & シート数).Range("E2") <> "" Then
Sheets("購入者" & シート数).Name = Sheets("購入者" & シート数).Range("E2") & IIf(n(シート数) = 0, "", n(シート数) + 1)
End If
Next

p.s.
ちなみに、補足のプログラムは、同名が無い場合に動いてましたか？
Sheets("購入者" & シート数).Name = Range("E2")
のRange("E2")は、特定のシートを見ているんじゃないかと思いますが・・・
Sheets("購入者" & シート数).Name = Sheets("購入者" & シート数).Range("E2")
にしないと、同名が無くても、動かないんじゃないかと思うんですが・・・
特に複数のシートを扱う場合は、シートも含めたセルの指定をしないと痛い目にあいますよ、多分。

お礼

言われたとおりにやってみたところ、まさに希望通りのことが出来ました！！
なにぶんまだＶＢＡをはじめて日が浅いので
難しいことはできないもので
こういうふうに教えていただけて非常に助かりました。

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

回答No.2

imogasi

＃１です。
補足で質問の内容が変わった意味になったように思うが、見る前に
下記を考えた
ーー
シートは複数ある。その各シートのB列には氏名を入れる。同じ名前が入ったら、警告する。入力の名前は排除しない。
シートではなく、ThisworkbookのSheetChange　イベントに
下記をコピペ。
ーー
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
MsgBox Target
On Error GoTo err1
If Target.Column = 2 Then
x = Application.WorksheetFunction.Match(Target, Worksheets("Sheet4").Range("A1:A200"), 0)
MsgBox x
End If
MsgBox "同名あり"
Application.EnableEvents = True
Exit Sub
err1:
d = Worksheets("Sheet4").Range("A200").End(xlUp).Row
Worksheets("Sheet4").Cells(d + 1, "A") = Target
Application.EnableEvents = True
End Sub
ーー
上例では、重複しない名前をSheet4のA列に、入力と共に蓄積していく。入力の都度、その中に同名が無いかチェックし、あれば警告メッセージを出す。
Sheet4は氏名集約の作業シートだから別として、Sheet1－＞Sheet2－－＞Sheet3と移ってもコードは変えなくても良いようになっているはず。
ーー
ただChangeイベントは、キャンセルやDELやそういう操作に十分対応するのが難しい。
ーー
上記コードを質問者のニーズに合わせて修正する力があれば参考にしてください。

回答No.1

imogasi

関数を考えているのでしょうが、１列しか見ない関数がほとんどです。
シートの全体を探索するのも難しい。
１シートを探す、でVBAでやっとできる、だと思います。
数シート繰り返せばということになるが、やる気がしません。
本格的にやるなら、各シートのデータを寄せ集めたデータベース的な１本化したものをチェック用に作ることになると思います。
ただシートもふえ、名前も増えるので、入力完了瞬間的に塚とか難しい問題があります。VBAの中級までの人には無理でしょう。
あるシートの１列にダブりなしの名前をVBAでつくり、MATCH関数を入力の都度カマすか。

補足

そうですか…
むずかしいのですね。

なぜこれをやりたいかというと、
E2のセルに入力された値を、シートの名前としているのです。
だから、同じ名前が入っていると、同じシート名をつけられなくて
エラーが出てしまい、そこで処理がストップされてしまうからです。

For シート数 = 2 To 10
Sheets("購入者" & シート数).Name = Range("E2")
Next シート数

たとえば、
シート1…佐藤
シート2…鈴木
シート3…佐藤だったら佐藤2に勝手になるような方法は…

あったらぜひ教えてください。