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

回答No.3

mt2008 · ベストアンサー

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

お礼

回答が遅くなって申し訳ありません。

やりたい事を1個にしてそれを記述して、
それが正常に動いたら
次にやりたい事を1個だけ記述して
それが正常に動いたら
また．．．．
で繰り返して
たくさんできたプロシージャーを合体させて
重複部分は纏めるというので行いました。
重複部分の纏めはできませんでした。

あとインプットBOXに入力した値とSheet2のA列を検索して照合させるのが
どうしてもできませんでした。
Sheet2のA列には
=B2&C2&D2
と式が入れてあり
=B3&C3&D3
=B4&C4&D4
．
．
．
とデータのある行まで式が入っています。
この状態だとインプットボックス1～3に入力した値を連結させた値と
をぶつけてもヒットしませんでした。
Sheet2のA列をコピーして
「形式を指定して貼付」で「値」を選択して
A列に値を貼付して式を削除したらヒットするようになりました。
（よくわかりません。）
補足に完成したコードを記載します。
どうもありがとうございました。

補足

一応思ったとおりに動いているコード1/2
Sub 表示板作成()
ThisWorkbook.Activate
Sheets("Sheet1").Select
Dim 検索値1
Dim 検索値2
Dim 検索値3
Dim 検索値4
Dim 判定値
Dim 判断
Dim 確認
Dim 再確認
Dim 範囲 As Range
Dim Obj As Object
Dim nRow As Long
Set 範囲 = ThisWorkbook.Worksheets("Sheet2").Range("A2:G10000")
MsgBox "●してください", vbExclamation, "初期設定"
Do
検索値1 = Application.InputBox("型番を【半角で英数は大文字】で【ハイフンを抜いて】10桁か13桁か14桁で入力してください ")
'「キャンセル」押下の場合
If 検索値1 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
'指定文字数の時はループを抜ける
If Len(検索値1) = 10 Or Len(検索値1) = 13 Or Len(検索値1) = 14 Then
Exit Do
End If
MsgBox "指定文字数以外です。再入力してください", vbCritical, "エラー！！"
Loop
Do
検索値2 = Application.InputBox("●を半角英数で4桁で入力してください")
If 検索値2 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
If Len(検索値2) = 4 Then
Exit Do
End If
MsgBox "4桁ではありません。再入力してください", vbCritical, "エラー！！"
Loop
Do
検索値3 = Application.InputBox("●を半角英数で4桁で入力してください")
If 検索値3 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
If Len(検索値3) = 4 Then
Exit Do
End If
MsgBox "4桁ではありません。再入力してください", vbCritical, "エラー！！"
Loop
検索値4 = 検索値1 & 検索値2 & 検索値3
'検索値4のVlookupエラー回避の為検索地4の有無確認
Set Obj = Worksheets("Sheet2").Range("A2:A1000").Find(検索値4, LookAt:=xlWhole)
If Obj Is Nothing Then
MsgBox "該当データがありません。", vbCritical, "エラー！！"
MsgBox "型番を全角で入力しませんでしたか？", vbCritical, "エラー！！"
MsgBox ("入力間違いではない場合はマスタに未登録です。管理者に問い合わせてください。 ")
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Else
nRow = Obj.Row '該当行
End If
判定値 = Application.WorksheetFunction.VLookup(検索値4, 範囲, 7, 0)
If 判定値 = "済" Then
判断 = MsgBox("発行済みです。再度データ取得しますか？", vbYesNo + vbQuestion)
If 判断 = vbNo Then
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
End If
Sheets("Sheet1").Select
↓回答A-NO.2の補足に続く

回答No.7

layy

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

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

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

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

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

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

お礼

いろいろ、本を見たり
ＷＥＢ検索したり
やりたいことを一つだけの構文で
動きを確認。
それを合体。
（まだ纏めはできません）
必ずコンパイラを先に。
Ｆ８キーで1行ずつ、
変数はカーソルを持っていって
今は何が格納されているか確認。
Ｆ８キーで行の途中でエラーの場合
その事を検索して理解。
またウォッチも覚えました。
これで自己解析しやくなりました。
でなんとか乗り切っています。
ですが配列だけはどうしてもわかりません。
サンプルを記述して動かしてみても
まだ理解が出来ません。
いろいろとありがとうございました。

回答No.6

layy

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

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ができそうですし。

お礼

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

2行加えるのに半日もかかってしまいました。
（A-NO.5のお礼の件）

>似たような動きはまとめることがあります。
>最初は個々にバラバラで１行ずつ
>作っておいて動作確認できたら
>同じ機能で分かりやすいように改善していく。

教えていただうたとうり
やりたい事だけのコードを作成して
それが動くようになってから
動かしていると
・ここはこうした方が
というのが思いついて、WEBで検索して
それをまた単体で作成して正常動作がしたらそれを追加
しています。
なので処理は少ないのにコードは凄く
長くなってしまいました。
ですが長くても1行ごといや全体が何をしているのか
今回はよく分かります。
で次の
＞同じ事は纏める
これが現在出来ません。
変数宣言もなんか凄く多くなってしまいました。
とりあえず完成したコードは
回答A-NO.5とA-NO.6の補足に分割して掲載します。
暇があったら見てください。
（纏めてほしいという要求ではありません。
　今回はこのままで使います。）
どうもありがとうございました。

補足

思ったとうりに動いたコード1/2
Sub 表示板作成()
ThisWorkbook.Activate
Sheets("Sheet1").Select
Dim 検索値1
Dim 検索値2
Dim 検索値3
Dim 検索値4 'As Variant
Dim 検索値5
Dim 検索値6
Dim 判定値
Dim 判断
Dim 確認
Dim 再確認
Dim 範囲 As Range
Dim Obj As Object
Dim nRow As Long
Set 範囲 = ThisWorkbook.Worksheets("Sheet2").Range("A2:G20000")
MsgBox "●をONしてください", vbExclamation, "初期設定"
Do
検索値1 = Application.InputBox("品番を半角大文字で入力してください ")
'「キャンセル」押下の場合
If 検索値1 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
'指定文字数の時はループを抜けて次の処理へ
If Len(検索値1) = 10 Or Len(検索値1) = 13 Or Len(検索値1) = 14 Then
Exit Do
End If
MsgBox "指定した桁数ではありません。再入力してください", vbCritical, "エラー！！"
Loop
Do
検索値2 = Application.InputBox("●を半角英数で4桁で入力してください")
If 検索値2 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
If Len(検索値2) = 4 Then
Exit Do
End If
MsgBox "4桁ではありません。再入力してください", vbCritical, "エラー！！"
Loop
Do
検索値3 = Application.InputBox("●を半角英数で4桁で入力してください")
If 検索値3 = "False" Then
MsgBox "終了します", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
If Len(検索値3) = 4 Then
Exit Do
End If
MsgBox "4桁ではありません。再入力してください", vbCritical, "エラー！！"
Loop
検索値4 = 検索値1 & 検索値2 & 検索値3
検索値5 = StrConv(検索値4, vbNarrow) '全角→半角
検索値6 = StrConv(検索値5, vbUpperCase) '小文字→大文字

'検索値4が検索範囲に無いとVlookupがエラーになるのでCountifで有無を確認
Set Obj = Worksheets("Sheet2").Range("A2:A20000").Find(検索値6, LookAt:=xlWhole)
If Obj Is Nothing Then
MsgBox "該当データがありません。", vbCritical, "エラー！！"
MsgBox "品番を英数字以外で入力しませんでしたか？", vbCritical, "エラー！！"
MsgBox ("入力間違いではない場合はマスタに未登録です。管理者に問い合わせてください。 ")
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Else
nRow = Obj.Row '該当行
End If
判定値 = Application.WorksheetFunction.VLookup(検索値6, 範囲, 7, 0)
If 判定値 = "済" Then
判断 = MsgBox("発行済みです。再度データ取得しますか？", vbYesNo + vbQuestion)
If 判断 = vbNo Then
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
End If
End If
Sheets("Sheet1").Select

回答NO.A-NO.5の補足に続く

回答No.5

layy

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！」を表示せよ、
１～１０までの合計を算出して表示せよ、
キーボードから値を２つ入力して四則演算し表示せよ、
そんなことから始めます。
やりたいことが自分でできるようになるのは、ずっと先の話です。

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

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

お礼

ユーザーから
正規→16B4567
誤り→16b４５６７
とインプットボックスに入力後
エラー判定して再入力を促す方法ではなく
半角→全角や大文字→小文字の間違い入力くらいは
正規と扱って検索で完全一致と判定して欲しい　
と要望されました。
スレッドを立ち上げて質問しようと思いました。

-以下のコードで
-【検索値4】
-に格納された値が
-全角→半角
-小文字→大文字
-に変換できるといいのですが....。

質問文を作成してふと思いました。
検索値4を変換すればいい。
web検索で
全角→半角
小文字→大文字
をするには？を調べました。
検索値4 = 検索値1 & 検索値2 & 検索値3
検索値5 = StrConv("検索値4",vbNarrow)
検索値6 = StrConv("検索値5",vbUpperCase)
としました。
でF8キーで1行づつ、で変数に何が格納されたか
見ていたら全角→半角
小文字→大文字に変換されません。
WEBで見つけたのは

StrConv("ＡＢＣ",vbNarrow)
→ＡＢＣ→ABC

ＡＢＣという文字だから””ではさんである。
検索値4は変数だから””はいらない？
と思い
検索値5 = StrConv(検索値4,vbNarrow)
検索値6 = StrConv(検索値5,vbUpperCase)
で思ったとおり動きました。
馬鹿みたいな事かも知れませんが
質問しないで解決できました。
これも教えていただいたように
やりたい事だけのコードにしてみたら修正できました。
本当にありがとうございました。

Sub　検索転記実験（）
Set 範囲 = ThisWorkbook.Worksheets("Sheet2").Range("A2:G20000")
検索値1 = Application.InputBox("●を半角英数で6桁で入力してください")
検索値2 = Application.InputBox("●を半角英数で3桁で入力してください")
検索値3 = Application.InputBox("●を半角英数で3桁で入力してください")
検索値4 = 検索値1 & 検索値2 & 検索値3
検索値5 = StrConv(検索値4,vbNarrow)
検索値6 = StrConv(検索値5,vbUpperCase)
Set Obj = Worksheets("Sheet2").Range("A2:A20000").Find(検索値4, LookAt:=xlWhole)
If Obj Is Nothing Then
MsgBox "該当データがありません。"
Else
Range("C21").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 2, 0)
Range("C22").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 3, 0)
Range("C23").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 4, 0)
Range("C24").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 5, 0)
Range("C25").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 6, 0)
End　Sub

補足

思ったとうりに動いたコード2/2

↑回答NO-A-NO.6の補足の続き↓

Range("C21").Value = Application.WorksheetFunction.VLookup(検索値6, 範囲, 2, 0)
Range("C22").Value = Application.WorksheetFunction.VLookup(検索値6, 範囲, 3, 0)
Range("C23").Value = Application.WorksheetFunction.VLookup(検索値6, 範囲, 4, 0)
Range("C24").Value = Application.WorksheetFunction.VLookup(検索値6, 範囲, 5, 0)
Range("C25").Value = Application.WorksheetFunction.VLookup(検索値6, 範囲, 6, 0)
'該当行G列に「済」を入れる
Worksheets("Sheet2").Cells(nRow, 7) = "済"
'印刷部分は省略
確認 = MsgBox("これは●が発行されます。いいですか？", vbYesNo + vbQuestion)
Select Case 確認
Case vbNo
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Case vbYes
End Select
再確認 = MsgBox("●は電源がONされていますか？", vbYesNo + vbQuestion, "再確認")
Select Case 再確認
Case vbNo
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Case vbYes
MsgBox "ラベルを発行します。"
Call 印刷
End Select
MsgBox "ラベルが発行されたのを確認してください。"
Call 定位置
End Sub
----------------
Sub 印刷()
ThisWorkbook.Activate
Sheets("Sheet1").Select
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ActivePrinter = "Brother PT-9500PC on Ne07:"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub
-----------------
Sub 定位置()
ThisWorkbook.Activate
Sheets("Sheet1").Select
Range("C21:C25").Select
Selection.ClearContents
Range("A2").Select
End Sub

回答No.4

layy

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

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

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

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

例えば、
'検索値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

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

お礼

>「デバッグ」です。
>１行ずつ実行してくれる手法もあります。

これはF8キーで一行づつ動作させる事でしょうか？
それはいつもやっているのですが。
F8キーでいきなりエラーになる時と
どこかの行でエラーになる時があります。
どこかの行の場合はなんとか対処できる時もかろうじて
あるのですが、
SUB（ ）の所でエラーだと場合によってお手上げです。
「End Ifに対するIfがありません」とかならいいのですが
「オブジェクトがありません」とかだと.....。

>できる部分（骨組）から積み上げて確実にすること、
>基本的なやり方です。
>「デバッグ」する手法も身につけること。
>検索値を入力する部分、
>それができたら、セルに反映する部分、
>それもできたら、結果を判定する部分、
>それぞれパーツで考えてみる。

質問後、A-NO.3さんのアドバイスから修正する時に
今回はこれでやってみました。
途中で何回も再質問しようと思いましたが
凄く時間がかかりましたが質問しないでできました。

>完全でないまま先を急がないこと。
>修正するたびに「コンパイル」
>文法エラーがないかチェックする癖をつけても
>少しは違います。

最初からわかっているのにあえて分けて考えるのでしょうか？
入力する値は帳票の離れた位置にある3ケ所の値で
検索値の入力はユーザーに14+4+4を頭の中で連結してもらい
入力してもらうつもりでインプットボックスは1個
の予定でした。
ユーザーから「いっぺんに22文字も入力？間違えそうだけど。」
と言われて入力する値は
項目単位で3回に分ける事にして
BOX出して14文字入力して、
BOX出して4文字入力して
BOX出して4文字入力して、
とするからインプットBOXは3個だから
最初から3個作成しないと駄目だと思いました。
あとから追加しても修正できないのではと思いました。

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

結果だけ聞いても、その文が何をしているのか
いつも分からずWEB検索して調べて自分なりのコメントを
'　で入力しているのですが
1行ごとの調査の為全体がよく分かりません。

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

【デバッグ】
これはVBEを開いてSub（ ）にカーソルを置いて
F8キーで1行づつ実行することでしょうか？
これはいつもやっています。
いきなりマクロ実行はやった事ないです。
大半が最初でエラーになって、そのエラーの部分が修正できなくて
困っています。
【質問も少なく】
今回の修正では途中で10回ほど再質問してしまおうと
思いましたがしなくてできました。
A-NO.3さんが書いてくれたのが大きいのですが。
【意欲】
凄く有るつもりですが、でもできないのです。
それで困っています。
きっとまだ足りないのですね。

教えていただいたURLはもう何人の方からも
紹介していただき何回も何回も読んでいますが駄目です。
基礎から学びなおした方が．．．．と
学び方が分かりません。
分からない所がわかりません。

教えていただいたURLの中の【Excelでお仕事】の中にある
「初心者のよくある疑問や間違いや誤解」の部分
は今回初めて読みました。
（他の部分はよく読みましたがこの部分は過去一度も
　　目をとうした事がなかったです。）
これは今回凄く参考になりました。
これをもっと早く読めばよかったです。
マクロについては今以上に余計にわからなくなり
もう辞めるべきとの判断もできました。
物事の考え方や順序については大変参考になりました。
マクロ以外で役に立ちそうです。
いろいろとありがとうございました。

回答No.2

mt2008

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

・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の値が更新されるわけでは有りません。

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

お礼

申し訳ありません。

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

最初はInputBoxは1回の予定でした。
検索値しかなかったです。
途中で3回に増やしたので
そこが検索値1～4にしたので
修正忘れです。

>・Do～Loop、Exit Doの使い方がおかしい。

はい。わかりました。すいません。
１個の作業ならできたのですが今はできなくなりました。

>・変数に.Valueは不要

はいすいません。
でもどこかでこう教わった記憶があるのですが。

>・変数「検索値4」の値が常に空白
あっ。すいません。
これは間違いです。動作しないのでここへ移動しました。
教えていただいたとうりこれでは空白です。
申し訳ありません。

>長めのマクロを組む時は、いっぺんに作ってしまわず、エラーにならない骨組だけを先に作り、

はい。そのとうりに行った結果が現状なのです。
で動作しないので、削除、修正、移動
していたら、わけがわからなくなりました。

大変申し訳ありません。

どうもありがとうございました。

補足

↑回答A-NO.3の補足からの続きです。
一応思ったとおりに動いたコード2/2

Range("C21").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 2, 0)
Range("C22").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 3, 0)
Range("C23").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 4, 0)
Range("C24").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 5, 0)
Range("C25").Value = Application.WorksheetFunction.VLookup(検索値4, 範囲, 6, 0)
'該当行G列に「済」を入れる
Worksheets("Sheet2").Cells(nRow, 7) = "済"
確認 = MsgBox("これは【●用】が発行されます。いいですか？", vbYesNo + vbQuestion)
Select Case 確認
Case vbNo
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Case vbYes
End Select
再確認 = MsgBox("●は電源ONされていますか？", vbYesNo + vbQuestion, "再確認")
Select Case 再確認
Case vbNo
MsgBox "終了します。", vbExclamation, "注意"
Call 定位置
Exit Sub
Case vbYes
MsgBox "発行します。"
Call 印刷
End Select
MsgBox "発行されたのを確認してください。"
Call 定位置
End Sub

----------------

Sub 印刷()
ThisWorkbook.Activate
Sheets("Sheet1").Select
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ActivePrinter = "●"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

--------------------

Sub 定位置()
ThisWorkbook.Activate
Sheets("Sheet1").Select
Range("C21:C25").Select
Selection.ClearContents
Range("A2").Select
End Sub

回答No.1

layy

どう直せば？

と限界に来ている点のが問題だろう。

LOOPやELSEやENDIFの記載位置は掲示板への転記時に誤りで実際はあっているとして、
エラー発生行はどこかは見つけているのか。
メッセージボックス追記したり、デバッグ作業はできないのか。

イレギュラーが起きるたびに対処は大変なので、作る前に何がイレギュラーか整理するのが先。

機能ばかり先行して覚えているのではないか。
なら、組み立て、基本はできているか、教える人いなかったか。

お礼

申し訳ありません。
2000字を超えてしまいかけませんでした。

If Len(検索値) < 18 Then
オブジェクトが必要です

となりました。
ここでつまづいて困っています。

>LOOPやELSEやENDIF

これはVBEがアドバイスしてくれるので
それに従うのですが、あまり増えてくると
よくわかりません。

>イレギュラーが起きるたびに対処は大変なので、
>作る前に何がイレギュラーか整理するのが先。

はい。わかりました。すいません。

>機能ばかり先行して覚えているのではないか。

機能はまだよくわかりません。

>なら、組み立て、基本はできているか、教える人いなかったか。

ここでよく教えていただきました。
で基礎からやり直した方がいいとか
サイトも紹介してくださいます。
また本も買いました。

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

すいません。申し訳ありません。
これはもう修正不可能と判断すれば
いいのでしょうか？
修正不可能ならば仕方ないので諦めます。
どうもありがとうございました。