エクセルのフォームの

質問

エクセルのフォームの

テキストボックスの値をエクセルシートに入れていっているのですが
フォームを閉じる時に、重複した値のチェックを入れたいのですが
A:Bの列でチェックしたい項目が２つあって、どちらも満たしたときに
エラーメッセージを出したいのですが、本を見ても載っていないので
質問させていただきました。

列Aは番号
列Bは氏名です。

A　　　　　B
1001001　山本
2001001　山本
3001001　鈴木
3001010　鈴木
3001001　鈴木

この例だと3001001　鈴木が重複していますので
２回目に入力した分を削除しようとしています。

すみませんがどなたか教えてください。
よろしくお願いいたします。

回答No.7

myRange · ベストアンサー

暇にまかせてまたまた登場、myRangeです。

----------------------------------------------------------

＞Msg = MsgBox("課題番号:" & kadaiCode & "" & Namae1& _
"は登録済みです。上書きしますか？", vbYesNo,"確認")
＞の部分が赤くなってしまいました。

入力ミスしてますよ。当方の回答では

Msg = MsgBox("課題番号:" & kadaiCode & "" & Namae1▼& _
"は登録済みです。上書きしますか？", vbYesNo,"確認")

▼のところにスペースがひとつあるはずです。

---------------------------------------------------------

＞上書きするボタンを押すと　実行時エラー1004
＞アプリケーション定義またはオブジェクトの定義エラーとなり
＞.cells(Gyou,D).Value = kingaku1が黄色になりました。

これまた入力ミスです。回答では

　.Cells(Gyou, ▼"D"▼).Value = Kingaku1

Ｄがダブルクォーテーションで囲まれてますよね？

----------------------------------------------------------

（注意事項）
●入力する時は、一字一句、確かめながら入力すること。
●エラーが出たら入力ミスがないかちゃんと確認のこと。

で、ミスをなくすためには、なるべく回答コードをコピペする。(^^;;;

以上です。

お礼

myRangeさん

大変失礼しました。
コピペではなく自分でコードを書きながらやった方が覚えるのかなと
思って、手入力で入力ミス…　しょうもないです。すみません。
メッセージボックスの中のスペースと""の位置がよく分からない…のです。
勉強不足ですみません。

myRangeさんは説明がとても上手で、入門者にもよく理解が出来ました。
コードの書き方はまだまだ分からないことばかりですが、本を読み読み
アドバイスをいただきながら、今後も頑張りたいと思います。

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

回答No.6

myRange

マルチページコントロールについてはご自分で勉強する、ということで。。

'----------------------------------
Private Sub cmdTouroku1_Click()

　Dim KadaiCode As Long '●数値
　Dim KadaiMei As String
　Dim Namae1 As String
　Dim Kingaku1 As Long

　Dim Kensuu As Long
　Dim Gyou As Long

　Dim R As Long
　Dim Msg As Integer
　'Dim Flag As Boolean　'●今回は使わないので不要

　KadaiCode = Val(txtKadaiN.Text)　'●数値変換
　KadaiMei = txtKadaiMei.Text
　Namae1 = txtNamae1.Text
　Kingaku1 = CLng(txtKingaku1.Text)　'●数値変換

'▼ダブりチェック

With Worksheets("電話帳")
　Kensuu = .Cells(1, 5).Value　'●●Kensuuはここで取得しておく
　For R = 2 To Kensuu + 1
　　If .Cells(R, "A").Value = KadaiCode And .Cells(R, "C").Value = Namae1 Then
　　　　Gyou = R
　　　　Exit For
　　End If
　Next R
End With

If Gyou <> 0 Then
　　Msg = MsgBox("課題番号：" & KadaiCode & " " & Namae1 & _
　　　　　　" は登録済み、上書きしますか？", vbYesNo, "確認")
　　If Msg = vbYes Then
　'▼ダブり上書き
　　　　With Worksheets("電話帳")
　　　　　.Cells(Gyou, "D").Value = Kingaku1
　　　　End With
　　End If
Else
　'▼ダブりなしの処理
　　Kensuu = Kensuu + 1
　　Gyou = Kensuu + 1
　　With Worksheets("電話帳")
　　　.Cells(Gyou, 1).Value = KadaiCode
　　　.Cells(Gyou, 2).Value = KadaiMei
　　　.Cells(Gyou, 3).Value = Namae1
　　　.Cells(Gyou, 4).Value = Kingaku1
　　　.Cells(1, 5).Value = Kensuu
　　End With
End If

'▼TextBoxクリアー＆番号へ
　　txtKadaiN.Text = ""
　　txtKadaiMei.Text = ""
　　txtNamae1.Text = ""
　　txtKingaku1.Text = ""
　　txtKadaiN.SetFocus
End Sub
'------------------------------------

●ダブりの上書きは、金額だけにする

●変数の宣言は、一行ずつにした方が分かりやすい。
　また、Dim Namae1, kadaiMei, kadaiCode As String
　こういった宣言では、Namae1とkadaiMeiはVariant型になる

●書込み行はセルＥ１を使わないで自動取得が普通ですが
　本を見ながらということですのでそのままにしてあります。
　因みに最終行は、以下で取得できます。

　　　Cells(Rows.Count,"A").End(xlUp).Row

以上です。

補足

myRangeさん
返信ありがとうございます。

教えていただいたコードをさっそく書き込んでみたのですが、
If Gyou <> 0 Then
Msg = MsgBox("課題番号:" & kadaiCode & "" & Namae1& _
"は登録済みです。上書きしますか？", vbYesNo,"確認")

の部分が赤くなってしまいました。
それで、ダブルクオテーションを増やしてみたところ　課題番号："＆kadaiCode&"&Namae1&"は…
とメッセージ内容が変わってしまいました。

あと、上書きするボタンを押すと　実行時エラー1004
アプリケーション定義またはオブジェクトの定義エラーとなり、デバッグを押すと
.cells(Gyou,D).Value = kingaku1が黄色になりました。

どうしてでしょうか。。

回答No.5

myRange

こんばんは、myRangeです。

まだ補足がないようなので質問者のコードをちょと眺めてみました。
あと少し補足が必要です。

●提示のコードで判断すると見出しは

　Ａ（課題番号）Ｂ（課題名）Ｃ（名前）Ｄ（金額）

となってるようですが、
最初の質問ではＡ列とＢ列が同じだったらダブりにする、となってますよね？
で、当方の回答もそうなってますが、
実際は、Ａ列とＣ列が同じだったらダブりとするのでは？

●シート電話帳のセルＥ５に現在の登録件数が入っていて、
　そして、見出しは、１行目で、データは２行目からですね？

●UserFormが表示されてるとき、シート電話帳はアクティブか、そうでないか？
（これはアクティブだったらコードが短くなるので）

以上です。

補足

myRangeさん
ご回答いただいていたのに、返信が遅くなり申し訳ありません。

（１）課題番号は、数値なのか文字列なのか？→数値です。
（２）ダブりがあった時に上書きする場合は、
　　　ヒットした行に上書きする　→です。

また
>最初の質問ではＡ列とＢ列が同じだったらダブりにする、となってますよね？
>で、当方の回答もそうなってますが、
>実際は、Ａ列とＣ列が同じだったらダブりとするのでは？

すみません。実際はA列とC列がダブリだったらの判定をします。
上書きを聞くようにするのは、金額が変わったりするからです。

>シート電話帳のセルＥ５に現在の登録件数が入っていて、
>そして、見出しは、１行目で、データは２行目からですね？

「はじめての裏技ExcelVBA」という本を見て書いたので、１件づつ増やすには
現在の登録件数を入れてそれに１づつ追加する、というやり方でしたので…。
見出し、データともにおっしゃるとおりです。

>UserFormが表示されてるとき、シート電話帳はアクティブか、そうでないか？
>（これはアクティブだったらコードが短くなるので）

シート電話帳は、非アクティブでもどちらでもいいのです。

もともとはいくつかのCSVデータをエクセルに加工したものをいったんマルチページの１ページ目
に読み込んで、マルチページ２～５ページを手入力で入れるというフォームなのです。
共通しているのは課題番号と課題名です。

今教えていただいているのは、２～５ページの手入力の部分で、それは紙ベースでデータが
ないので、マルチページの１ページ目のデータを読み込んでいるシート（ライトといいます）とは
別に、電話帳（名前は変ですが）というシートに手入力の分だけデータを入力していっている
という感じです。
本当は、ライトというシートに追加していきたいのですが、やり方が分からなかったんです。
でも今こうして教えていただきながらやっていると、なんとなく分かるような…気がしてきました。

返答になっていますでしょうか。

回答No.4

myRange

またまたmyRangeです。

一発必中の回答をするためには最低限以下の補足が必要です。

（１）課題番号は、数値なのか文字列なのか？

（２）ダブりがあった時に上書きする場合は、
　　　ヒットした行に上書きするのか
　　　それとも、最終行＋１行目に、新たに書き込むのか

今から帰宅予定ゆえ、回答は夜になります。
以上です。

回答No.3

myRange

回答２、myRangeです。

＞重複したデータを登録せずやめるか、
＞上書きするかを聞くようにしたいのですが

ダブりのデータを上書きしてもあまり意味がないと思いますが、、、
ま、それは置いといて、、、

先の回答にも書きましたが全体のコードが提示されてないので、部分回答。
MsgBoxにYesNoボタンを表示しそれで分岐します。

'-------------------------------------------------
Private Sub CommandButton1_Click()
　Dim R As Long
　Dim Flag As Boolean

　For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
　　　If Cells(R, "A").Value = Val(TextBox1.Value) And _
　　　　　Cells(R, "B").Value = TextBox2.Value Then
　　　　　　　　Flag = True
　　　　　　　　Exit For
　　　End If
　Next R

　Dim Msg　　　　'●●YesNo用変数を追加

　If Flag = True Then
　　　Msg = MsgBox(TextBox1 & " " & TextBox2 & " はダブりです" _
　　　　　　& vbLf & vbLf & "上書きしますか？", vbYesNo, "確認")

　　　If Msg = vbYes Then
　　　　　'●●ここに上書きコード●●　　
　　　Else
　　　　　TextBox1.Value = ""
　　　　　TextBox2.Value = ""
　　　　　TextBox1.SetFocus
　　　End If

　　　Exit Sub
　End If

　　　'＝＝▼以下、正常処理＝＝

End Sub
'--------------------------------------------

■■更に質問があるときはコードを全部提示のこと。
以上です。

補足

myRangeさん
確かに上書きの必要は…と思いますが、ありがとうございました。
分岐を追加したのですが、YesNoすら聞いてこなくなってしまいました。
上書きのコードは最初に実行したコードを書けばよいのですよね？
でもきっと何かが足りないのです。全部コピーしましたので、見ていただけないでしょうか。
----
Private Sub cmdTouroku1_Click()

Dim Namae1, kadaiMei, kadaiCode As String
Dim Kingaku1, Kensuu, Gyou, R As Long
Dim Flag As Boolean
Dim Msg As Byte

kadaiCode = txtKadaiN.Text
kadaiMei = txtkadaiMei.Text
Namae1 = txtNamae1.Text
Kingaku1 = txtKingaku1.Text

Kensuu = Worksheets("電話帳").Cells(1, 5).Value
Kensuu = Kensuu + 1
Gyou = Kensuu + 1

With Worksheets("電話帳")
.Cells(Gyou, 1).Value = kadaiCode
.Cells(Gyou, 2).Value = kadaiMei
.Cells(Gyou, 3).Value = Namae1
.Cells(Gyou, 4).Value = Kingaku1
.Cells(1, 5).Value = Kensuu
End With

For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(R, "A").Value = Val(txtKadaiN.Value) And _
Cells(R, "B").Value = txtNamae1.Value Then
Flag = True
Exit For
End If
Next R

If Flag = True Then
Msg = MsgBox("課題番号：" & txtKadaiN.Value & " " & txtNamae1.Value & " はすでに登録されています。上書きしますか？", vbYesNo, "確認")

If Msg = vbYes Then

Kensuu = Worksheets("電話帳").Cells(1, 5).Value
Kensuu = Kensuu + 1
Gyou = Kensuu + 1

With Worksheets("電話帳")
.Cells(Gyou, 1).Value = kadaiCode
.Cells(Gyou, 2).Value = kadaiMei
.Cells(Gyou, 3).Value = Namae1
.Cells(Gyou, 4).Value = Kingaku1
.Cells(1, 5).Value = Kensuu
End With

Else
txtNamae1.Value = ""
txtKingaku1.Value = ""
txtNamae1.SetFocus
End If
End If
Exit Sub
End Sub

回答No.2

myRange

全体のコードが提示されてないので質問部分だけについて。。。

'-------------------------------------------------
Private Sub CommandButton1_Click()
　Dim R As Long
　Dim Flag As Boolean

　For R = 1 To Cells(Rows.Count, "A").End(xlUp).Row
　　　If Cells(R, "A").Value = Val(TextBox1.Value) And _
　　　　　Cells(R, "B").Value = TextBox2.Value Then
　　　　　　　　Flag = True
　　　　　　　　Exit For
　　　End If
　Next R

　If Flag = True Then
　　　MsgBox TextBox1.Value & " " & TextBox2.Value & " はダブり！"
　　　TextBox1.Value = ""
　　　TextBox2.Value = ""
　　　TextBox1.SetFocus
　　　Exit Sub
　End If

'＝＝▼以下、正常処理＝＝

End Sub
'--------------------------------------------

質問例の番号は数値のようなので、
比較時点で、Val(TextBox1.Value)と数値変換してあります。

以上です。

補足

myRangeさん
ありがとうございます。
結果がちゃんと出ました。

さらに質問させてください。

重複したデータを登録せずやめる
（テキストボックスをクリアにするやりかたは
　さきほど教えていただきました）
か、
上書きするかを聞くようにしたいのですが
どのようにすればよいでしょうか。

回答No.1

aokii

A列最優先、B列を２番目に優先、にして並べ換えしてから、
Ｃ列に、以下を入れて下にドラッグコピーみて下さい。
C1セル=IF(A1&B1=A2&B2,"重複データ","")

補足

aokiiさん
ありがとうございます。
シート上で作業する分にはこれでいいと思うのですが
フォームの確認ボタンを押したときに、この作業が
出来るとよいのですが、VBAにこの関数を書くときは
どのようにしたらいいでしょうか。