InputBoxの値で検索して転記するマクロ
1.InputBoxを3回表示させます。
2.ユーザーに入力してもらいます。
入力できるのは半角英数字のみでそれ以外は
エラーメッセージを出したいです。
3.1回目は18桁か22桁以外の場合、
2回目と3回目は4桁以外の場合はMsgBoxを表示して
再入力を促します。
4.InputBoxに入力された値の3個を連結した値で
Sheet2のA列を検索して
合致したらその行のG列の値を見ます。
5.G列に"済"とあったら
MsgBoxを表示して
中止するか継続するか判断します。
6.継続した場合
その該当行の各列の値をSheet1にそれぞれ転記します。
Sheet2の該当行のB列→Sheet1のセルB3
Sheet2の該当行のC列→Sheet1のセルC3
Sheet2の該当行のD列→Sheet1のセルD3
Sheet2の該当行のE列→Sheet1のセルE3
Sheet2の該当行のF列→Sheet1のセルF3
7.かつSheet2の該当行のG列に 済 と転記します。
すでに済が記入されている場合は上書です。
以下のように作成しましたがエラーで動かなくて動作確認が出来ません。
どう直せばいいのか教えてください。
イレギュラー時の対応処理が必要だとも思うのですが動作しない為
思いつきません。
記述が滅茶苦茶なのですがこれが限界です。申し訳ありません。
Sub 表示板作成()
Dim 検索値1
Dim 検索値2
Dim 検索値3
Dim 検索値4
Dim 判定値
Dim 判断
Dim 記録
Dim 確認
検索値4 = 検索値1&検索値2&検索値3
Do
検索値1 = Application.InputBox("型番を入力してください")
If Len(検索値) < 18 Then
MsgBox "18桁未満です。再入力しますか？"
Loop
Else
Exit Do
'検索値2と3も上記と同じ記述をここへ入れる
'（現在省略）
End If
判定値 = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 7, 0)
If 判定値 = "済" Then
判断 = MsgBox("発行済みです。再度データ取得しますか？", vbYesNo)
Else
Select Case 判断
Case vbNo
Exit Sub
Case vbYes
Range("B3").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 2, 0)
Range("B4").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 3, 0)
Range("B5").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 4, 0)
Range("B6").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 5, 0)
Range("B7").Value = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 6, 0)
End Select
End If
記録 = Application.WorksheetFunction.VLookup(検索値4.Value, Worksheets("Sheet2").Range("A2:G10000"), 7, 0)
記録.Value = "済"
確認 = MsgBox("これは●●用です。いいですか？", vbYesNo)
Select Case 確認
Case vbNo
Exit Sub
Case vbYes
Call 印刷
End Select
End Sub
お礼
回答ありがとうございます。 できました！ お世話になりました。