エクセルVBAもし同じ値なら！！

質問

エクセルVBAもし同じ値なら！！

開いているBookのFormから違うBookのSheet1のA列にDATAを入力することはできます。
例）TextBox1の値があれば次の列に入れることはできます。

悩んでいるのは
(1)TextBox1と違うBookの"Sheet1”のA列が同じ値なら
　MsgBox "既に登録済みです。"と表示させて
　ElseでDATAを入力させたいです。

'使用行を格納
lngYcnt_K = SH1.UsedRange.Rows.Count
For lng = 1 To lngYcnt_K
'TextBox1と同じ値を見つけてテキストボックスの値を入力。
If CStr(TextBox1.Text) = CStr(SH1.Cells(lng, 1)) Then

MsgBox "既に登録済みです。"
Else
最終行 = SH1.Range("a65536").End(xlUp).Row

TextBox1.Text = SH1.Cells(lng, 1)
TextBox2.Text = SH1.Cells(lng, 2)
End If
Next lng

どのようにすれば良いのでしょうか？？
教えて下さい！

回答No.3

imogasi · ベストアンサー

したいことを文章で明確に表現できてないのでは。
それに表題が問題点を捉えてない。ー＞エクセルVBAもし同じ値なら！！ なんて難しい点ではない。
この質問は、質問者が考えているのとは別の、初心者にとって、他の結構難しい問題を抱えていると思う。
ーー
改めて質問を書いてみると
Book1,Book2があって、Book1のユーザーフォームのテキストボックスに値を入れる。フォームのコマンドボタンでもクリックしたとき、
Book2のSheet1のＡ列に、同じ値があれば、そのコメントを表示。無ければＡ列最後の行の次行に、
そのテキストボックスの値を代入する。
ということか。
表現は短く、的確になるじゃないか。
ーーー
Book1の標準モジュールに
Public sh2
Sub test01()
Workbooks.Open "01化.xls"
Set sh2 = Workbooks("XXXXXX.xls").Sheets("Sheet1")
End Sub
Book2（XXXXXX.xls）を開き、使えるようにする。
Userform１のコマンドボタンのコードに
Private Sub CommandButton1_Click()
s = TextBox1.Text
d = sh2.Range("A65536").End(xlUp).Row
'MsgBox d
For i = 1 To d
If sh2.Cells(i, "A") = s Then
MsgBox "同じ値有り"
TextBox1.Text = ""
Exit Sub
End If
Next i
sh2.Cells(d + 1, "A") = "'" & s
TextBox1.Text = ""
End Sub
ーーー
ただし
Book１を開いたとき
Test01() を実行
Userform1　　の表示
Book1をクローズしたときBook2のクローズ、Sh2のNothing化
が必要。
ーー
例えば
Book1のOpenイベントに
Private Sub Workbook_Open()
test01
UserForm1.Show
End Sub
がいると思う。

お礼

ありがとうございます。
返事が送れてすいませんでした。

本当にそうですよね
質問側が内容をまとめていないです。
それでも回答していただきありがとうございます。

回答No.2

n-jun

ワークシート関数のCOUNTIFで、
そのセル範囲にデータ個数が
０か否かで判断するとか？

最終行の次にデータを書き込むのなら、

With SH1
'使用行を格納
lngYcnt_K = .UsedRange.Rows.Count

'TextBox1と同じ値があるかどうか。
If WorksheetFunction.CountIf(.Range("A1", .Cells(lngYcnt_K, 1)), TextBox1.Text) > 0 Then

MsgBox "既に登録済みです。"
Else
最終行 = .Range("a65536").End(xlUp).Row

TextBox1.Text = .Cells(最終行 + 1, 1) '最終行の次？
TextBox2.Text = .Cells(最終行 + 1, 2) '最終行の次？
End If

End With

こんな感じとか？（未検証ですけど）

補足

返事遅れてすいません！！

あれから悩み
等しくなかったら登録していき
それ以外はメッセージを出していきたいと思い作成
していますが…登録はできるのですが
同じID番号でも登録してしまいます！！
どうすれば良いのでしょうか？

lngYcnt_K = SH1.UsedRange.Rows.Count

For lng = 1 To lngYcnt_K
'TextBox1と同じ値を見つけてテキストボックスの値を入力。

If CStr(TextBox1.Text) <> CStr(SH1.Cells(lng, 1)) Then
lngNumber = SH1.Range("a65536").End(xlUp).Row + 1
SH1.Cells(lngNumber, 1) = CStr(lngNumber - 1)
SH1.Cells(lngNumber, 1) = TextBox1.Value 'ID
SH1.Cells(lngNumber, 2) = TextBox3.Value '氏名
'同じ値がある場合は空欄とする。
Else
lngNumber = SH1.Range("a65536").End(xlUp).Row + 1
MsgBox "既に登録済みです"

End If
Next lng

回答No.1

keys920

あまり詳しくないのですが、検索したら

http://q.hatena.ne.jp/1230453996

こんなのありましたが、これと似ていませんか？

お礼

ありがとうございます。