InputBoxの値で検索して転記するマクロ

Question

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

mt2008 · Accepted Answer

No.2です。
こういうことかなぁと言う感じに整形して見ました。
無駄な部分もありますが、あえて元のコードをなるべく活かしてます。

また、InputBoxの入力で半角英数だけに制限する事は出来ません、入力後に正規表現等を使用して半角英数のみかどうかを判断する事が多いです。
しかし、現時点ではそこまで考えると大変だと思いますので、入力時に気を付けて貰う方がよいでしょう。

Sub 表示板作成()
　　'Dim部省略

Dim Obj As Object
　　Dim nRow　as long

Do
　　　　検索値1 = Application.InputBox("型番を半角英数で入力してください")
　　　　'「キャンセル」押下の場合
　　　　If 検索値1 = "False" Then
　　　　　　MsgBox ("終了します")
　　　　　　Exit Sub
　　　　End If

'18文字以上の時はループを抜けて次の処理へ
　　　　If Len(検索値1) >= 18 Then
　　　　　　Exit Do
　　　　End If

MsgBox "18桁未満です。再入力してください"
　　Loop

'他の入力部省略

検索値4 = 検索値1 & 検索値2 & 検索値3

'検索値4が検索範囲に無いとVlookupがエラーになるのでCountifで有無を確認
　　　　
　　　　Set Obj = Worksheets("Sheet2").Range("A2:A1000").Find(検索値4, LookAt:=xlWhole)
　　　　If Obj Is Nothing Then
　　　　　　MsgBox ("該当無し。終了します。")
　　　　　　Exit Sub
　　　　
　　　　Else
　　　　　　nRow = Obj.Row '該当行
　　　　End If

判定値 = Application.WorksheetFunction.VLookup(検索値4, Worksheets("Sheet2").Range("A2:G10000"), 7, 0)
　　If 判定値 = "済" Then
　　　　判断 = MsgBox("発行済みです。再度データ取得しますか？", vbYesNo)
　　　　If 判断 = vbNo Then
　　　　　　Exit Sub
　　　　End If
　　End If

Range("B3").Value = Application.WorksheetFunction.VLookup(検索値4, Worksheets("Sheet2").Range("A2:G10000"), 2, 0)
　　'中略
　　Range("B7").Value = Application.WorksheetFunction.VLookup(検索値4, Worksheets("Sheet2").Range("A2:G10000"), 6, 0)

'該当行G列に「済」を入れる
　　Worksheets("Sheet2").Cells(nRow, 7) = "済"

'印刷部分は省略

End Sub

layy · Answer

＞質問しないで解決できました。

個人的にはやってもらいたいことを少しでもわかっていただけたと思ってます。
質問者様でさらに磨きをかけて手順を見いだしてくれたら、と思います。

スバリ答えもらうことと自分で答え出したことと違うはず、
結果を急ぐなら答えはすぐ欲しいでしょうけど、
そこで何か得るものがあるのかどうか。

仕様（和文）を思い描いて、組立、分岐、パターン、そういうのを考えて
これなら大丈夫、となればいざコードを記述。
コードを書くにも（大文字小文字変換とか）書き方はSTRCONV使ったらできる、
ということですから、どちらかというと
そこに至るまでの「検索値4」に悩めばいいんです。
そこに至るまで（＝ロジック）が精度が高いと結果は出るというものです。

まとめ、これはすぐできるものかどうかはわかりません。
簡単に言えば
「検索値1～4」を「検索値」のセット４回繰り返し、
ということでもできるのではないか、という視点です。

いずれにしても、
作ったものの投稿前にもう１度見直しする癖もつけたら
質問は減るし、視点を変えて調べ方を覚えれば自分で解く力はつく、と思います。

layy · Answer

＞凄く時間がかかりましたが質問しないでできました。
収穫です。
回答を１行調べていくこととどっちが後で自分の力で残っているか、
活用できそうかを考えてみる。
これを繰り返せばこの時間が短くなると思ってください。

Dim 検索値1
Dim 検索値2
Dim 検索値3
Dim 検索値4 
これらは
Dim 検索値(4)
の配列で考えてみる。

Range("B3").Value
Range("B4").Value
にしても、
xl="B"&"3"
Range(xl).Value
であり
xl="B"&"4"
Range(xl).Value
ですから、xlを変数にした"3"から"4"のループでもできる。
例えばこういうのが纏めです。似たような動きはまとめることがあります。
最初は個々にバラバラで１行ずつ作っておいて動作確認できたら
同じ機能で分かりやすいように改善していく。
最初はこれでいいんです。
そのうちそこまで考えた上で記述できるようになります。
xl="B"&"3"
Range(xl).Value
で失敗したら、試した部分だけを
Range("B3").Value
に戻せばいい。

>Do
>検索値2 = Application.InputBox("
>Do
>検索値3 = Application.InputBox("
なんかも
最後には１つのdo～loopにして
１回目のとき、２回目のとき、・・とSelectCaseができそうですし。

layy · Answer

VBエラーとその対処方法
http://www.kitagawa-hanga.com/se/s_vberr.html
どんなことしたらエラーになるか、相手（VB側の仕掛け）を知るのも上達の一つです。

＞これはF8キーで一行づつ動作させる事でしょうか？
これができるのであれば、メッセージボックスもできているし
途中にどうなっているか、は見えてきます。
あやしい、自信がないところは罠をしかけてでも検証する。

＞項目単位で3回に分ける事にして
＞BOX出して14文字入力して、
＞BOX出して4文字入力して
＞BOX出して4文字入力して、
14文字の動作で22文字というわけでない。
分けるというのは、まずこの14文字の動作を確実にすること。
これが動けば同じ動きで4文字、4文字と増やしていけばよい。
これをしておけば間違いがさらに増えていくことは少ない。
＞BOX出して14文字入力して、
＞BOX出して4文字入力して
＞BOX出して4文字入力して、
といきなり記載しエラーが出ることで
14文字のところなのか4文字のところなのか
見直し箇所が増える。それだけ後戻りになる。
それがコード全体になると探すだけでロスになる。
機能縮小して・・・までできた、・・・までできた、のが着々と進む。
エラーが出ても追加した記載によっておかしくなるのだから
１世代前（の正しい状態）に戻して見直すことができる。
慣れてくるとその細切れ回数範囲が広がる。
【考え方は「大づかみ」から始めます。】
基本的な動きを確実にすることがよりベター。
INPUTBOXを入力する、３回繰り返す、が骨組。
エラーにしたりセルに転記するのはあとから追記する話。
エラーチェックないけど動くまでできた、じゃあエラーを追加するか、と
言う感じで取り組む。

＞1行ごとの調査の為全体がよく分かりません。
それはそうです。
コードから和訳（仕様）を掘り起こすのは本来の作成手順ではありません。
コードをもらうときは仕様説明ももらうことです。
和訳があってからコードを書く、のが普通。
新規作成で最初に考えるのは、ほとんどが命令でなく機能要件のはず。
和訳に相当する命令に置き換えていけば物はできる、というもんです。
仕様がきちんと記載あれば、おおまかな結果はたいていうまくいきます。
イレギュラーがあったり、機能改善したり、そんなのを後で追加していくもの。

＞学び方が分かりません。
これはしかたない部分あり。
最初は「こんなのやりたい」が先行します。
専門学校で最初に学ぶときは、
「Hello world！」を表示せよ、
１～１０までの合計を算出して表示せよ、
キーボードから値を２つ入力して四則演算し表示せよ、
そんなことから始めます。
やりたいことが自分でできるようになるのは、ずっと先の話です。

なにか自分なりのやり方がみつかればいいのですが・・・。
ヘルプをフルに活用してますか？。

本題については、見てみます。

layy · Answer

＞それを参考にするのですが．．．．．．

掲示板やネットでは正しく動くものを提供（回答）がほとんどです。
これは基本的な手順とは言い難い。初心者と知ってて教えているなら「教え方」も悪い。

「教えてもらっている」と思っていますが、
何か起きたとき、自分で対処する力がついて行っていません。
エラーが起きたときの処理、この訓練も行うこと。
「デバッグ」です。
１行ずつ実行してくれる手法もあります。

何か起きても大丈夫であれば、好き勝手につくっていっても
対処できればなんとかなりますが、あちこちでエラーが起きると、
いざどこでどうおかしいか見極めできないのです。
そのためにも、
できる部分（骨組）から積み上げて確実にすること、基本的なやり方です。
「デバッグ」する手法も身につけること。

例えば、
'検索値2と3も上記と同じ記述をここへ入れる
にあるように、検索値1が確実にできたら検索値2、検索値3と増やす。
次元が並列なら後でもいい。

検索値を入力する部分、
それができたら、セルに反映する部分、
それもできたら、結果を判定する部分、
それぞれパーツで考えてみる。

＞途中で3回に増やしたので
＞そこが検索値1～4にしたので
＞修正忘れです。
完全でないまま先を急がないこと。
修正するたびに「コンパイル」文法エラーがないかチェックする癖をつけても
少しは違います。

一気にコード記述すると、
「検索値を入力する部分」でエラーがあると
後続の「結果を判定する部分」に影響出ることだってあります。
どっちがおかしい？、になるのです。
「検索値を入力する部分」で確認が出来ていたら
後続の「セルに反映する部分」や「結果を判定する部分」に
エラーがあるのだろう、と想定できるわけです。

なので、
掲示板を使うにしても、
結果だけ聞いても不足している部分、吸収しなければいけない部分が多々ある。
その訓練は必要でしょう。

プログラムなので、使い方が合っていれば結果は伴います。
デバッグまでできるようになれば、質問も少なくなります。
作る意欲があれば、まだまだあきらめる必要はないです。

EXCEL
http://www.asahi-net.or.jp/~ZN3Y-NGI/YNxv20002.html
http://www.asahi-net.or.jp/~ef2o-inue/top01.html
http://www.voicechatjapan.com/excelvba/VBArei4.htm
http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_200.html

いずれにしても
今回のコードで、エラーなく正しい使い方で記載できている部分と
不安な部分を見直してもいいかと思います。

mt2008 · Answer

う～ん、色々と突っ込みどころがあるなぁ。

・InputBoxで値を代入している変数は「検索値1」なのに、その下のLenでは初めて出てきた「検索値」を使っている。

・Do～Loop、Exit Doの使い方がおかしい。
DoとLoopがセットです。このループから抜ける時にIF文などで条件判断してExitDoでループを抜けるようにします。

例：
Do
　　If If Len(検索値) < 18 Then
　　　　Exit Do
　　End If
Loop

・変数に.Valueは不要
誤：検索値4.Value
正：検索値4

・変数「検索値4」の値が常に空白
先頭で検索値4 = 検索値1&検索値2&検索値3
と書くと、その時の検索値1～3の値をくっつけた物が　検索値4 に入ります。
その後、検索値1～3の値が変わっても、検索値4の値が更新されるわけでは有りません。

長めのマクロを組む時は、いっぺんに作ってしまわず、エラーにならない骨組だけを先に作り、少しづつ機能を組み込んではステップ実行でデバッグ……を繰り返した方が結果的に効率が良い事が多いですよ。

layy · Answer

どう直せば？

と限界に来ている点のが問題だろう。


LOOPやELSEやENDIFの記載位置は掲示板への転記時に誤りで実際はあっているとして、
エラー発生行はどこかは見つけているのか。
メッセージボックス追記したり、デバッグ作業はできないのか。

イレギュラーが起きるたびに対処は大変なので、作る前に何がイレギュラーか整理するのが先。

機能ばかり先行して覚えているのではないか。
なら、組み立て、基本はできているか、教える人いなかったか。

InputBoxの値で検索して転記するマクロ

No.2です。

この回答への補足

＞質問しないで解決できました。

＞凄く時間がかかりましたが質問しないでできました。

この回答への補足

VBエラーとその対処方法

この回答への補足

＞それを参考にするのですが．．．．．．

う～ん、色々と突っ込みどころがあるなぁ。

この回答への補足

どう直せば？

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング