ユーザーフォームの値の重複登録を中止するには

質問

UserForm1の登録ボタン(CommandButton2)を押したときに、フォーム上の会社番号及び注文番号の二つの数値を参照して、Sheet1上の会社番号と注文番号の列から、すでに同じ会社番号で同じ注文番号が登録されてないか確認します。

例えば、フォーム上の会社番号2で注文番号104は、シート上でも会社番号2で注文番号104があるため、msgbox "既に登録済みです"を表示させて登録を中止するにはどうすれば良いでしょうか。

現状、登録ボタンを押しと時に実行させる処理は以下の通りです。

Private Sub CommandButton2_Click()

Dim rc As Integer
rc = MsgBox("記録を保存しますか？", vbYesNo + vbQuestion, "保存")
If rc = vbYes Then

If TextBox1.Value = "" Or TextBox2.Value = "" Or TextBox3.Value = "" Or TextBox4.Value = "" Then
MsgBox "未入力な項目があります。"
Else
Dim tr As Range
Set tr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

tr.Offset(0, 0).Value = UserForm1.TextBox1.Value
tr.Offset(0, 1).Value = UserForm1.TextBox2.Value
tr.Offset(0, 2).Value = UserForm1.TextBox3.Value
tr.Offset(0, 3).Value = UserForm1.TextBox4.Value

MsgBox "保存しました。"
End If

Else
MsgBox "キャンセルしました。"
End If

End Sub

回答No.5

imogasi · ベストアンサー

質問の表現が悪い（問題の本質を表してない）。
＞表題の、ユーザーフォーム、の問題ではない。
質問に、長々と自分の、うまく行かないコードなど掲げる必要はない。
＝＝
いわば、標題は、「データシートにおいて、2列の項目それぞれで、同じデータあるかどうか、の判定方法」だろう。
普通は、２条件は、SQLのSELECT文などを使えば簡単なのだろうが、エクセルではSQLは面倒だ。
ーー
色々考えると、COUNTIFS関数をVBAで使うのが（コード行数が少ない点やエクセル関数愛好家が多いので）一番簡単でわかりやすいだろう。
ーー
データ例
C,D列
会社名 注文番号
会社A 102
会社B 103
会社C 104
会社D 106
会社E 107
会社F 108
標準モジュールに
Sub test01()
s1 = "会社C"
s2 = 105
c = Application.WorksheetFunction.CountIfs(Range("C1:C1000"), s1, Range("d1:d1000"), s2)
MsgBox c
End Sub
これを実行してCが０と返るなら登録、１（以上）なら、重複していると、却下する、というコードにしたら（組み入れれば）仕舞。
「データシートにおいて、複数列の項目それぞれで、指定データがあるかどうか、全部満たす」は、典型的なパターンの問題なので、自分の、レパートリーを、日ごろから勉強して、ふやしておくべきなんだ。

お礼

ご回答ありがとうございます。ここで質問する前に、countifsを見つけて、ユーザーフォームの値を検索条件にするにはどうすれば良いか悩んでいた次第です。

以下のコードでうまく動作しました。感謝です。
Dim c As Long

c = Application.WorksheetFunction.CountIfs(Range("B2:B1000"), Me.TextBox2.Value, Range("d2:d1000"), Me.TextBox4.Value)
If c = 1 Then
MsgBox "重複が" & c & "個あり"

Else
MsgBox "重複なし" 'ここにない場合の処理を記述

End If

回答No.4

kkkkkm

No3の蛇足です。

Find～FindNextを利用した一例です。

Dim FRange As Range, LastRow As Long
Dim firstAddress As String

LastRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row

With Sheet1.Range(Cells(2, "B"), Cells(LastRow, "B"))
Set FRange = .Find(What:=Val(UserForm1.TextBox2.Value), _
LookIn:=xlValues, LookAt:=xlWhole)
If Not FRange Is Nothing Then
firstAddress = FRange.Address
Do
If FRange.Offset(0, 2).Value = Val(UserForm1.TextBox4.Value) Then
MsgBox "既に登録済みです", vbCritical
Exit Sub
End If
Set FRange = .FindNext(FRange)
If FRange Is Nothing Then Exit Do
Loop Until FRange.Address = firstAddress
End If
End With

参考サイト
https://www.moug.net/tech/exvba/0050116.html

お礼

ご回答ありがとうございます。期待通りの動作をしました。とてもスマートなコードだと思いました。

私なりに以下のようにコードの内容を理解しました。

B列の最終行の値を変数LastRowに取得して
B列の2行目から最終行までを参照してTextBox2と完全位置する値を探し見つかれば、そのセル番号を
取得して、そこから2列右のD列の同じ行のセル値をTextBox4と見比べて、同じであれば
登録済み、なければLoopから抜け出る。

勉強になります。m(_ _)m

回答No.3

kkkkkm

No1の変更です。

こちらで試してみてください。

Dim mRow As Long
Dim i As Long, LastRow As Long

LastRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To LastRow
mRow = 0
On Error Resume Next
mRow = CLng(WorksheetFunction.Match(Val(UserForm1.TextBox2.Value), Sheet1.Range(Cells(i, "B"), Cells(LastRow, "B")), 0))
On Error GoTo 0
If mRow > 0 Then
If Sheet1.Cells(i + mRow - 1, "D") = Val(UserForm1.TextBox4.Value) Then
MsgBox "既に登録済みです", vbCritical
Exit Sub
End If
End If
If mRow <> 0 And mRow <> LastRow Then
i = i + mRow - 1
End If
Next

回答No.2

kkkkkm

No1です。
No1はエラーがありますので実行しないでください。

回答No.1

kkkkkm

以下を追加して試してみてください。
他にFind～FindNextを使う方法もありますが、そちらは検索したら説明しているサイトがあると思いますので、そちらから流用してください。

Dim mRow As Long: mRow = 0
Dim i As Long, LastRow As Long

LastRow = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRow
On Error Resume Next
mRow = CLng(WorksheetFunction.Match(Val(UserForm1.TextBox2.Value), Sheet1.Range(Cells(i, "B"), Cells(LastRow, "B")), 0))
On Error GoTo 0
If mRow > 0 And Sheet1.Cells(i + mRow - 1, "D") = Val(UserForm1.TextBox4.Value) Then
MsgBox "既に登録済みです", vbCritical
Exit Sub
End If
If mRow <> LastRow Then
i = i + mRow - 1
End If
Next