プロが教える店舗&オフィスのセキュリティ対策術

VBE初心者ですみません。
VBEコーディングしていたのですが、重複チェックが永遠に終わらずにフリーズしてしまします。
助けていただけると幸いです。
内容は下記になります。

(”SYSTEM”)のシート上にあるユーザーフォームを使い(”TBL_2021年度”)のシートの最下行にデータ登録を行いたい。
■詳細
登録内容は下記(ユーザーフォーム)
・氏名(空白・重複チェック)
・部署(空白チェック)
・利用開始日(空白チェック)
・PC分類(空白チェック)
・引当PC(空白チェック)
・備考

上記内容で登録するのですが、まずユーザーフォーム登録時に下記TextBoxが空白かチェックする機能をつけています。
・氏名(空白・重複チェック)
・部署(空白チェック)
・利用開始日(空白チェック)
・PC分類(空白チェック)
・引当PC(空白チェック)
上記内容に空白がなかった場合、(”TBL_2021年度”)のシートのB列の氏名に今回追加する氏名が重複していないかチェックします。

チェックした結果重複していなければ、(”TBL_2021年度”)のシートの最下行にデータ追加する受胎にしたいのですが可能でしょうか?

下記、作成したコード内容です。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Sub フォーム起動_Click()

登録foam.Show

End Sub

'ユーザーフォーム登録をクリック
Private Sub page1登録_Click()

'更新画面の停止
Application.ScreenUpdating = False

'①ユーザーフォームに空白があった場合
If TextBox氏名 = "" Or ConboBox部署 = "" Or TextBox利用開始日 = "" Or TextBoxPC分類 = "" Or TextBo引当PC = "" Then
MsgBox "未入力箇所があります。"
Else

'①ユーザーフォームに空白がなかった場合、データの重複確認
'②登録対象者が既存のデータで重複していた
Dim I As Long
Dim MyR As Range

Set ws01 = Worksheets("TBL_2021年度") 'ワークシートの設定

Sub フォーム起動_Click()

登録foam.Show

End Sub

'ユーザーフォーム登録をクリック
Private Sub page1登録_Click()

'更新画面の停止
Application.ScreenUpdating = False

'①ユーザーフォームに空白があった場合
If TextBox氏名 = "" Or ConboBox部署 = "" Or TextBox利用開始日 = "" Or TextBoxPC分類 = "" Or TextBo引当PC = "" Then
MsgBox "未入力箇所があります。"
Else

'①ユーザーフォームに空白がなかった場合、データの重複確認
'②登録対象者が既存のデータで重複していた
Dim I As Long
Dim MyR As Range

Set ws01 = Worksheets("TBL_2021年度") 'ワークシートの設定

maxrow = Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To maxrow

For Each MyR In Cells(I, 4)
If MyR.Value = TextBox3 Then

MsgBox "商品ID重複"
Cancel = True
Exit Sub


'②登録対象者が既存のデータで重複していない ③確認作業が終わったので指定セルの最下行に登録
Else
With Cells(Rows.Count, 1).End(x1Up)
.Offset(1.1) = TextBox氏名
.Offset(1.2) = ComboBox部署
.Offset(1.3) = TextBox利用開始日
.Offset(1.4) = TextBoxPC分類
.Offset(1.5) = TextBox引当PC
.Offset(1.6) = TextBoxpage1備考
End With

End If

Next MyR
Next I

Unload 登録form
End If
End Sub


'ユーザーフォームでの登録内容をメールにて送信


'ユーザーフォーム画面に戻る


For Each MyR In Cells(I, 4)
If MyR.Value = TextBox3 Then

MsgBox "商品ID重複"
Cancel = True
Exit Sub


'②登録対象者が既存のデータで重複していない ③確認作業が終わったので指定セルの最下行に登録
Else
With Cells(Rows.Count, 1).End(x1Up)
.Offset(1.1) = TextBox氏名
.Offset(1.2) = ComboBox部署
.Offset(1.3) = TextBox利用開始日
.Offset(1.4) = TextBoxPC分類
.Offset(1.5) = TextBox引当PC
.Offset(1.6) = TextBoxpage1備考
End With

End If

Next MyR
Next I

Unload 登録form
End If
End Sub


'ユーザーフォームでの登録内容をメールにて送信


'ユーザーフォーム画面に戻る

A 回答 (3件)

こんにちは


>ユーザーフォーム重複・空白チェック
>'①ユーザーフォームに空白がなかった場合、データの重複確認
'②登録対象者が既存のデータで重複していた
Dim I As Long
Dim MyR As Range
Set ws01 = Worksheets("TBL_2021年度") 'ワークシートの設定
maxrow = Cells(Rows.Count, 1).End(xlUp).Row
For I = 2 To maxrow
For Each MyR In Cells(I, 4)
If MyR.Value = TextBox3 Then
MsgBox "商品ID複"
Cancel = True
Exit Sub
このコードは、Private Sub page1登録_Click()内に書いているのでしょうか?
Cancel = True などから想像すると

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
とした方が良いと思います。

例:
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextBox3.Value <> "" Then
If WorksheetFunction.CountIf(Range("D:D"), TextBox3.Value) > 0 Then
MsgBox ("商品ID重複")
Cancel = True
Exit Sub
End If
End If
End Sub

TextBox3に入力後、他のオブジェクトに移動した時(TextBox3から抜ける時)に実行されますのでボタン、
Private Sub page1登録_Click()ないで処理する必要がありません。

If  Else の考え方は良いのですが、チェックなどの場合は、Elseでなく
処理を中止すると言う考え方の方が判り易いのではないでしょうか。
(処理が出来ないわけではありませんが)

>If TextBox氏名 = "" Or ConboBox部署 = "" Or TextBox利用開始日 = "" Or TextBoxPC分類 = "" Or TextBo引当PC = "" Then
MsgBox "未入力箇所があります。"
Else ’Else でなく

If TextBox氏名 = "" Or ConboBox部署 = "" Or TextBox利用開始日 = "" Or TextBoxPC分類 = "" Or TextBo引当PC = "" Then
MsgBox "未入力箇所があります。"
Exit Sub
End If ’未入力があったら中止する

処理ブロックを分けて考えると不具合の箇所も判り易くなるのではないかと思います。

VBE初心者と言う事で、
VBEの使い方としては、コードを実行する前に メニューバーにある
デバッグのVBA VBAProjectのコンパイルを押してコンパイルするようにしましょう。
出来るだけ変数は宣言しましょう。
メニューバーのツールにあるオプションの編集タグ内のチェックボックスはすべてチェックを入れる事をお勧めいたします。

ご質問欄に転記の場合は、コピペにする方がタイプミスなどが無いと思います。
With Cells(Rows.Count, 1).End(x1Up) ×
With Cells(Rows.Count, 1).End(xlUp)  〇

余談
ご質問にある一定の解決方法や目途が立った場合、
解決した方法や目途が立つ内容を返信や補足に書き
スレッドを閉じるようにしましょう。
次の質問、スレッドは閉じた後にするように心がけましょう。
    • good
    • 0

こんにちは


>重複チェックが永遠に終わらず
このループ?ステップ実行などで今一度確認されてみてはいかがでしょう

余計なお世話かもしれませんが、
> Each MyR In Cells(I, 4) 
In の右辺はコレクション、レンジ範囲、配列などの集合でなければ
For Next させる意味がないように思います。

また、最終行ナンバーをA列で取得しているのに 該当列はD列になっています。このような事もあるとは思いますが、前項の重複を探す目的なら
同じ列にするべきと思います。

>maxrow = Cells(Rows.Count, 1).End(xlUp).Row
>For I = 2 To maxrow
他の部分でIやmaxrowが使われていないのであれば

上記は不要で
For Each MyR In ws01.Range(ws01.Cells(2, 4), ws01.Cells(Rows.Count, 4).End(xlUp))

あと、ユーザーフォームのオブジェクトなどを参照する場合は、
プロパティを明示するようにしましょう
If MyR.Value = TextBox3.Value Then
など、、
    • good
    • 0

>Set ws01 = Worksheets("TBL_2021年度") 'ワークシートの設定



ワークシートを変数に代入してますが使われている様子はありません。
登録する際に該当のワークシートがアクティブになっていての不具合発生なのか、或いは別のワークシートをアクティブにしていての不具合発生なのかをまずは切り分けてみるとか?

重複はCOUNTIF関数で可能と思いますよ。
『VBA COUNTIF』でググってみるとか。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!