エクセルでユーザーフォームの入力時に重複チェックしたいのですが・・・。

質問

エクセルでデータベースを作り、ユーザーフォームにて
入力作業を行っています。
フォーム上にテキストボックスが２つ有り、
一つは日付、もう一つは名称を入力する仕様と
なっています。
またシートへの書き込みはコマンドボタンで
処理を行うようにしています。

このフォームで日付と名称を入力したときに、
そのデータをシートに書き込む前に
同じデータがすでにデータベースの中にある場合に
重複がある旨のメッセージダイアログを表示させたいと
思います。

処理条件としては、
１．日付、名称それぞれのテキストボックスを
抜けたとき（Private Sub TextBox1_Exit()）に
処理させること
２．入力した日付と同じ日付のデータベースにおいて
名称が同じかどうかで判断すること
３．重複があればダイアログ表示、なければ何もなし

ちなみにデータベースはA列に日付、B列に名称が
入っているものとします。
また上に処理条件を記しましたが、もっと良い方法が
あれば加えてアドバイス願います。

VBA初心者ですので解説付きコードで教えてください。
（非常にあつかましいのですが、余り時間がないため、
明日の朝9時までにご回答頂けると非常に助かります。
その際、もっとも的確で早い回答をくださった方に
20ポイントつけさせて頂きます。）

どうぞ宜しくお願いします。

回答No.2

zap35

スルーしようかとも思いましたが、希望納期も過ぎましたし、そろそろいいでしょうかｗ

まずは苦言から。「20ポイント」も愉快ではありませんが、「VBA初心者」を自称しておきながら不完全な「処理条件」を堂々と突きつける辺りにあきれて補足要求する気にすらなれませんでした。「これがやりたい」とだけ書いていただく方が、余程気持ちよく回答できます。
aoincさんがお金を出して下請けに作らせるのなら、このような方法でも良いのでしょうが、なにせここは「自発的な」回答者ばかりですので…ｗ

最初に前提を書きます。
入力したデータを書き込むシートは仮に「Sheet1」とします。その他に作業用シートとして「Sheet2」があるものとします。
データ件数も分からないのでシート関数を併用する方法を採りました。その方がFor～Next文を使うより高速と思ったからです。

UserForm1には
　TextBox1　（日付入力用）
　TextBox2　（名前入力用）
　CommandButton1　（登録用）
　Label1　（警告メッセージ用）
が配置されているものとします。その上でUserForm1のコードシートに以下を貼り付けてイミディエイトペインから
　UserForm1.Show
で動かしてみてください。

フォーカスのコントロールは私の思いこみで書いています。データエラーチェックはしていませんので必要に応じて追加してください。またその他のコントロールについてはご自由になさってください。（そこまでは「処理条件」に書かれていませんでしたので…）

Option Explicit
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
　Label1.Caption = ""
　CommandButton1.Enabled = True
　Sheets("Sheet2").Range("A1") = TextBox1.Text
　If Sheets("Sheet2").Range("A3") > 0 Then
　　Label1.Caption = "重複あり"
　　CommandButton1.Enabled = False
　End If
End Sub

Private Sub TextBox2_change()
　Label1.Caption = ""
　Sheets("Sheet2").Range("A2") = TextBox2.Text
　If Sheets("Sheet2").Range("A3") > 0 Then
　　Label1.Caption = "重複あり"
　　CommandButton1.Enabled = False
　Else
　　CommandButton1.Enabled = True
　End If
End Sub

Private Sub CommandButton1_Click()
Dim LastR As Long
　LastR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
　Sheets("Sheet1").Cells(LastR + 1, 1) = TextBox1.Text
　Sheets("Sheet1").Cells(LastR + 1, 2) = TextBox2.Text
　Sheets("Sheet2").Range("A3").Formula = "=SUMPRODUCT((Sheet1!A2:A" & _
　　LastR + 1 & "=A1)*(Sheet1!$B$2:$B$" & LastR + 1 & "=A2)*1)"
　TextBox2.Text = ""
　Sheets("Sheet2").Range("A2") = TextBox2.Text
　TextBox2.SetFocus
End Sub

Private Sub UserForm_Activate()
Dim LastR As Long
　LastR = Sheets("Sheet1").Range("A65536").End(xlUp).Row
　Sheets("Sheet2").Range("A3").Formula = "=SUMPRODUCT((Sheet1!A2:A" & _
　　LastR + 1 & "=A1)*(Sheet1!$B$2:$B$" & LastR + 1 & "=A2)*1)"
End Sub

動作は確認してありますが、解説は遠慮しておきます。ポイントも勿論いりません。

回答No.1

onlyrom

こんばんは。

１０行もあればすむコードに何故回答がつかないのか、
それはたぶん最後の
＞もっとも的確で早い回答をくださった方に20ポイントつけさせて頂きます
この余計なコメントのせいだろうと推測。

何にもならないポイント欲しさに回答する人、いないと思ふ。(^^;;;
何れにしろ人にものを教えてもらう態度ではない。
以上。