[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『比較NGの時の処理ストップについて』（ちむちむ）
現在、前任者のVBA改修をしようとしています。
勉強中の身であり、どうコードを記載すればいいのか、分かりません。
テキストボックス1にデータを入力→ENTER
シート内に同発注番号があれば、該当箇所に日時を入力する
これは下記でできていると思っています。
追加機能として、入力したデータがシート内に無い場合、
メッセージ出力して処理をストップさせたいです。
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim cprCol As Integer, timCol As Integer, cntCol As Integer
Dim sGyo As Integer
cprCol = 8 '照合する列
timCol = 11 '時間を入力する列
'cntCol = 20 'カウントを入力する列
sGyo = 9 'スタート行
If KeyCode = 13 Then 'Enterキー
For i = sGyo To 50000
'突合せ、日時入力
If Cells(i, cprCol) = "" Then Exit For
If UCase(TextBox1.Text) = UCase(Cells(i, cprCol)) Then
Cells(i, timCol) = Now()
Cells(i, timCol).Select
TextBox1.Text = ""
End If
Next
End If
End Sub
簡単かもしれませんが、後学のためどうぞよろしくお願いします。
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
If Application.CountIf(Cells(sGyo, cprCol).EntireColumn, TextBox1.Text) = 0 Then Exit Sub を必要な箇所に追記してください。 ご自身の語学のために、どうぞ。 （tkit） 2021/03/05(金) 17:11
衝突しましたが、せっかく書いたので書き込みます
コメント入れました。
If KeyCode = 13 Then 'Enterキー
For i = sGyo To 50000 ' Next までの間を iを1～5000まで繰り返す
If Cells(i, cprCol) = "" Then Exit For ' セルが空白だったら、For～Nextを抜ける（Nextの次の行から実行）
If UCase(TextBox1.Text) = UCase(Cells(i, cprCol)) Then ' テキストボックスとセルの値が同じだったら
Cells(i, timCol) = Now() ' セルに時間を入れる
Cells(i, timCol).Select ' セルを選択する
TextBox1.Text = "" ' テキストボックスを空にする
End If
Next
End If
9行目から5000行まで1行づつ繰り返し比較していってます。 もし空白行があったら For Nextループを抜けますが、 For Nextループのあとは実行可能なコードがないので、実質的に終了です。
つまり、空白行が見つかった＝入力したデータがシート内に無い ので、 そこでメッセージを出せばいいです。
追伸 このコードはデータがヒットしてもテキストボックスを空にして、 その後も最終行まで真面目に比較を続けてますが、 UCase(TextBox1.Text) = UCase(Cells(i, cprCol)) は絶対に True にならないので 無駄ループです。 テキストボックスを空にしたら、Exit For してもいいと思います。 （´・ω・`） 2021/03/05(金) 17:18
ご教授ありがとうございます。
まだ組み込めていませんが、コードを読みながら追記、テストしてみたいと思います。
'突合せ、日時入力
1 If Cells(i, cprCol) = "" Then Exit For
2 If UCase(TextBox1.Text) = UCase(Cells(i, cprCol)) Then
3 Cells(i, timCol) = Now()
4 Cells(i, timCol).Select
5 TextBox1.Text = ""
↑
説明しやすいように連番を振っています。
1でシートの対象箇所が空白の場合、処理を抜ける
2でテキストボックス1の入力とシート1の対象セルがイコールか確認
OKであれば、3～4で同セルの同行にチェック日時を自動入力する
5でテキストボックス1をクリアする
の認識です。相違ないでしょうか？
自分がやるを想像しながら考えていたのですが、
入力が数千件～1万件近くある場合があります。
入力し、ENTER押下した後、
マッチングNGの場合、テキストボックス1にデータが残ったままとなります。
ここはクリアしても問題ないでしょうか？
とにかく、入力を進めて、
どこかで未入力もしくはマッチングNGの箇所を再度入力するなど。
この辺り、構築する上での考え的にいかがでしょうか？
(書くはいいですが、コードは全然出てこないですが…)
週末、会社出てきて勉強します。
（ちむちむ） 2021/03/05(金) 18:11
お世話になります。
シート内は重複データが存在しないため、(前提でシートができている認識)
初回見つけて処理終了で問題ないと判断しております。
仮に重複をチェックするとなると、正直私の力量ではコードは難しいのが現状です。
問題提起いただきながら、申し訳ございません。
（ちむちむ） 2021/03/05(金) 18:59
＞入力が数千件～1万件近くある場合があります。
もし、入力値がリスト化されているのであれば、
一括で実行したいところですね。
動作させていませんが、以下のコードで
一括でできると思います。
数千件～1万件の手打ちは気が遠くなります・・・
コンパイルエラーが出ない事しか確認していませんので、
試される場合はバックアップ必須です。
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode <> 13 Then Exit Sub 'Enterキーではなかったら、ここで終了
'▼TextBox1に、「シート名,セルアドレス」入力前提
'例「Sheet1,A1:A1000」
Dim TextBox入力値() As String
TextBox入力値() = Split(TextBox1.Value, ",")
If UBound(TextBox入力値) <> 1 Then
MsgBox "書式が違います", vbExclamation
Exit Sub
End If
Dim 検索値の配列 As Variant
検索値の配列 = Worksheets(TextBox入力値(0)).Range(TextBox入力値(1)).Value
Dim cprCol As Integer, timCol As Integer, cntCol As Integer
Dim sGyo As Integer
cprCol = 8 '照合する列
timCol = 11 '時間を入力する列
'cntCol = 20 'カウントを入力する列
sGyo = 9 'スタート行
Dim 最終行 As Long
Dim 照合範囲 As Range
最終行 = Cells(Rows.Count, cprCol).End(xlUp).Row
Set 照合範囲 = Cells(sGyo, cprCol).Resize(最終行 - sGyo + 1, 1)
Dim 検索値 As Variant, 見つかった位置 As Long
For Each 検索値 In 検索値の配列
'ワークシート関数で検索
見つかった位置 = Application.IfError(Application.Match(検索値, 照合範囲, 0), 0)
If 見つかった位置 > 0 Then
照合範囲(見つかった位置).Offset(0, timCol - cprCol).Value = Now()
End If
Next 検索値
End Sub
（tkit） 2021/03/08(月) 16:25
お世話になっています。
休日出てきてやっているのですが、
正しいものが入力してOKから進みませんでした。
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim cprCol As Integer, timCol As Integer, cntCol As Integer
Dim sGyo As Integer
cprCol = 8 '照合する列
timCol = 11 '時間を入力する列
'cntCol = 20 'カウントを入力する列
sGyo = 9 'スタート行
If KeyCode = 13 Then 'Enterキー
For i = sGyo To 50000 ' Next までの間を iを1～5000まで繰り返す
If Cells(i, cprCol) = "" Then Exit For ' セルが空白だったら、For～Nextを抜ける（Nextの次の行から実行）
If UCase(TextBox1.Text) = UCase(Cells(i, cprCol)) Then ' テキストボックスとセルの値が同じだったら
Cells(i, timCol) = Now() ' セルに時間を入れる
Cells(i, timCol).Select ' セルを選択する
TextBox1.Text = "" ' テキストボックスを空にする
End If
Next
End If
End Sub
あと、tkitさん私が分からずお伝えできていませんでしたが
まずUSER FORMというものにtextbox1があり、それがファイル起動後に
表示されます。
そのtextbox1に入力し、enterすると発注番号と一致したシート内の発注番号の横に
チェックした日時が入力するような仕組みとなります。
よって、入力は一覧があるわけでなく、
都度伝票見ながら発注番号を打ち込む
発注表に発注番号があればOKとして日時が入力される
ような流れとなります。
私が理解できておらず、お手間取らせて申し訳ございません。
（ちむちむ） 2021/03/08(月) 18:36
⇒貼り付けてあるコードは前と同じですよね？
元々動作するか分からなかったということですか？
私には分かりません。
元々の希望であった処理を止めることはできましたか？
（tkit） 2021/03/09(火) 08:34
正しいものの説明が曖昧でした。申し訳ございません。
通常、発注番号として
textbox1にR02-0001を入力します。
シート上の発注番号を探し、ヒットすればK列の同行に日時を入力する
textbox1内をクリア
次に
textbox1にR02-0003を入力
シート上の発注番号を探し、ヒットすればK列の同行に日時を入力する
textbox1内をクリア
次に
R02-0010を入力
シート上の発注番号を探し、ヒットしなかったので
textbox1内をクリア
以下、続く
・
・
・
と言う流れです。
入力する発注番号は各部ごとに全社の一覧から空き番をアサインして
発注番号とするため、飛び飛びの可能性はあります。
よって、私の部を集約したリストから発注がちゃんと行えているか
確認するために、発注番号を確認できたものをチェック(日時を入力)したいというのが
希望で改造しようとしているところです。
説明が分かり辛く、お手間とらせてしまい、すいません。
（ちむちむ） 2021/03/10(水) 14:52
＞R02-0010を入力
＞シート上の発注番号を探し、ヒットしなかったので
＞textbox1内をクリア
上記の処理を追加したい、と捉えています。
提示されたコードをいじって上記機能を
追加しました。
もし私がその業務を行うのであれば、
1.集約した注番をどっかの列に張り付けた別のマクロブックを準備
2.１のマクロブックでチェックブックを開く
3.マクロブックで集約した注番とチェックブックの注番を比較し、
確認できれば、チェックブックに日時を入力
みたいな感じでいちいちTextBoxに入力しません。
集約した注番がリスト化できるかが鍵ですね。
PCスペックにもよりますが、1分もかからないかと。
'※照合、入力するシートをアクティブにして実行してください
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim 照合列 As String: 照合列 = "H" '照合する列
Dim 入力列 As String: 入力列 = "K" '時間を入力する列
Dim 開始行 As Long: 開始行 = 9 'スタート行
If KeyCode <> 13 Then Exit Sub 'Enterキーではなかったら、ここで終了
'ワークシート関数で、照合列のTextBox値をカウント
Dim 照合数 As Long
照合数 = Application.CountIf(Cells(開始行, 照合列).EntireColumn, TextBox1.Value)
If 照合数 <> 1 Then
Select Case 照合数
Case Is = 0: MsgBox "ヒット無し", vbInformation
Case Is > 1: MsgBox "複数ヒット", vbInformation
End Select
TextBox1.Value = ""
Exit Sub
End If
Dim 照合列最終行 As Long
照合列最終行 = Cells(Rows.Count, 照合列).End(xlUp).Row
Dim i As Long
For i = 開始行 To 照合列最終行
If UCase(TextBox1.Value) = UCase(Cells(i, 照合列).Value) Then
Cells(i, 入力列) = Now()
Cells(i, 入力列).Select
TextBox1.Value = ""
End If
Next i
End Sub
（tkit） 2021/03/10(水) 16:08
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.