VBA changeイベントにてVLOOKUPで検索する方法とエラーの

質問

VBA　changeイベントにてVLOOKUPで検索する方法とエラーの場合の方法

VBAは半年ほど独学で勉強してきましたが、どうにもならなくなったので、質問させてください。

以下、１つのブックです。

シート１＜管理台帳＞

　４行目を入力行として、

　B　　　　　C　　　　D　　　　E　　　　　F　　　　　　G　　　　　H　　　　　I　　　　J　　　　K　　L
伝票番号、日付、顧客名、顧客住所、集配地名称、集配地住所、数量A、数量B、数量C、備考、コメント
などを入力。
　マクロを使い、５行目以降にリストを追加。
　（これはなんとか自分で作成できました）

シート２＜住所録＞

　おもな顧客の住所録。
　シート１のD4セルに顧客名を入力すると、このリストから検索して、住所、主な集配地名称、住所をE4～G4に。
　（これもなんとかできました。）

ここからがどうしてもできないのですが。

シート３＜A伝票＞（シート１の数量Aの集計作業等の為）
　　K列に伝票番号を入力すると、シート１＜管理台帳＞から検索して、
L列に顧客名、M列に数量A、N列に備考、O列にコメントを表示したいんですが。

どうしてもうまくいきません。

自分で考えた末、伝票番号が文字列になっているのがいけないのかな？と思ったのですが・・・。
どう対処したらいいのかわかりません。
伝票番号は10桁。０からはじまるものもあるので、文字列として扱いたいです。
また、もし、伝票番号シート１に入力されていなかった場合、エラーメッセージを表示したいのですが・・・。

いろいろ試してみましたが、知識不足でなんともなりませんでした。
どなたかご指導いただけませんか？？

めちゃくちゃですが、下に自分なりに作ったコードをのせます。

新年度から使いたい、と思っていたものなので、少し、急いでおります。
どうか、よろしくお願いします。

Private Sub Worksheet_Change(ByVal Target As Range)

'伝票を　Ｋ列に入力すると、管理台帳から検索。

Dim rang1 As Variant
Dim rang2 As Variant
Dim 顧客名 As String
Dim 数量 As String
Dim 備考 As String
Dim コメント As String

Set rang1 = Columns("k")
Set rang2 = Worksheets("管理台帳").Range("B5:X20").Value

If Intersect(Target, rang1) Is Nothing Then Exit Sub

Application.EnableEvents = False

顧客名 = Application.WorksheetFunction.VLookup(Target.Value, rang2, 2, 0)
If TypeName(顧客名) <> "error" Then
Target.Offset(, 1) = 顧客名

数量 = Application.WorksheetFunction.VLookup(Target.Value, rang2, 12, 0)
If TypeName(数量) <> "error" Then
Target.Offset(, 2) = 数量

備考 = Application.WorksheetFunction.VLookup(Target.Value, rang2, 18, 0)
If TypeName(備考) <> "error" Then
Target.Offset(, 3) = 備考

コメント = Application.WorksheetFunction.VLookup(Target.Value, rang2, 20, 0)
If TypeName(コメント) <> "error" Then
Target.Offset(, 4) = コメント

Else
End If
End If
End If
End If
Application.EnableEvents = True

End Sub

回答No.4

myRange · ベストアンサー

またまた、myRangeです。

>Private Sub Worksheet_Change(ByVal Target As Range)
>に変えたのですが、そこだけ変えたのがまずいのでしょうか・・・・

あちゃー、、、、、(^^;;;
チョンボ続きで迷惑かけてますので最後まで付き合わねば。。

■考えられること。

１．文字列、数値の違い（これがもっとも考えられる原因）

＞シート１とシート３の数字が両方文字列であること、は確認しました。

とありますがどのように確認しましたか？
その方法を提示してください。

２．管理表のＢ列（検索列）にちゃんとデータはあるか
（本当にＢ列が検索したいデータなのかということです）

■それから、以下ようにMsgBoxを挿入して結果をお知らせください。
-------------------------------------------------------
LastRow = Worksheets("管理台帳").Cells(Rows.Count, "b").End(xlUp).Row
Set Rang2 = Worksheets("管理台帳").Range("b5:X" & LastRow)
　▼▼ここに追加
　　　Msgbox LastRow & " @ " & Rang2.Address(0,0)

Set Rang1 = Columns("K")
----------------------------------------

管理台帳の最終行が、９９行あれば、

　　９９　＠　Ｂ５：Ｘ９９　

と表示されるはずです。

■そしてまた、テストするときは、

「1111111111」こんな、ながーーーい番号は使わないで
「222」とか数桁のもの（簡単にチェックできるデータ）を使うのがベターです。

ま、何れにしろ、
処理的には簡単なものですから、ひとつずつ潰していきましょう。
そのためにはこちらの質問にはちゃんと的確に答えることが必須です。

▼▼▼早く解決したいときは、ここを３０分おきに見ること！！
少なくとも今日の午前中には解決したいものです。
以上です。

お礼

かさねがさねすいません。
何度も本当にありがとうございます。

＞▼▼▼早く解決したいときは、ここを３０分おきに見ること！！
＞少なくとも今日の午前中には解決したいものです。
＞以上です。

すいません。私の自宅のパソコンがネットにつながっておらず、会社でのみしかこちらへ来れません・・・。
また、本日、外出しており、こんな対応になり、申し訳ありません。
午前中、過ぎてしまいました・・。

＞シート１とシート３の数字が両方文字列であること、は確認しました。

＞とありますがどのように確認しましたか？
＞その方法を提示してください。

セルの書式設定で両方を文字列、としました。

＞２．管理表のＢ列（検索列）にちゃんとデータはあるか
＞（本当にＢ列が検索したいデータなのかということです）

こちらは間違いありません。

＞Msgbox LastRow & " @ " & Rang2.Address(0,0)
を追加したところ、

管理台帳１１行目が最終列で

１１　＠　Ｂ５：Ｘ１１
と出ました。

＞■そしてまた、テストするときは、

＞「1111111111」こんな、ながーーーい番号は使わないで
＞「222」とか数桁のもの（簡単にチェックできるデータ）を使うのがベターです。

おっしゃる通りです。
入力規則で文字列（長さ指定）10桁に設定していたので、それでテストしてしまいました。

そして、解除して、短い数字で実行してみたところ、できました！！

＞Msgbox LastRow & " @ " & Rang2.Address(0,0)

を抜いて実行しても、入力した番号が管理台帳にある場合はうまく動き、
ない場合は、メッセージボックスが出ました！！

また、その後、入力規則で再度、文字列（長さ指定）を10桁にし、
実行したところ、完璧に動きました！！

なぜ、入力規則をしなおしたらできたのかはさっぱりわかりませんが、無事、解決しました。

本当にありがとうございます。

うちの会社は事務員３名。VBAは全くつかっておりませんでした。

教えていただいたコードを元に、他の事にも応用できそうなので、勉強していきます。

初めて、こういう場で質問し、こんなに丁寧に答えていただいて、本当にありがとうございました。

回答No.3

myRange

回答２、myRangeです。

申し訳ありませんぬ。大チョンボ！(^^;;;

＞If Intersect(Target, Rang1) Is Nothing Then Exit Sub

これを下記の位置へ移動してください。

'------------------------------

　LastRow = Worksheets("管理台帳").Cells(Rows.Count, "B").End(xlUp).Row
　Set Rang2 = Worksheets("管理台帳").Range("B5:X" & LastRow)
　Set Rang1 = Columns("K")

If Intersect(Target, Rang1) Is Nothing Then Exit Sub

　On Error Resume Next

'-------------------------------

以上です。

お礼

ありがとうございます。
set が先かな～、とは思って、自分でも並び変えたりはしてみたんですが・・・・。

＞If Intersect(Target, Rang1) Is Nothing Then Exit Sub
を教えていただいた通りの位置に移動しました。

マクロは動いたのですが・・・。

管理台帳に確かにある数字を入力しても、
メッセージボックスに、「1111111111」はありません。
と出てしまいます。
数字を変えたりしてみても、どうしても「はありません」になってしまいますので、
本当に申し訳ないんですが、またおしえていただけないでしょうか・・・。

あと、Private Sub Worksheet_SelectionChange(ByVal Target As Range)
だったため、そのままでは、エンターを押し、下の行に移動したとき、になってしまうので、
Private Sub Worksheet_Change(ByVal Target As Range)
に変えたのですが、そこだけ変えたのがまずいのでしょうか・・・・？

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rang1 As Range
Dim Rang2 As Range
Dim 顧客名 As String
Dim LastRow As Long

LastRow = Worksheets("管理台帳").Cells(Rows.Count, "b").End(xlUp).Row
Set Rang2 = Worksheets("管理台帳").Range("b5:X" & LastRow)
Set Rang1 = Columns("K")

If Intersect(Target, Rang1) Is Nothing Then Exit Sub

On Error Resume Next

顧客名 = WorksheetFunction.VLookup(Target.Value, Rang2, 2, 0)
If Err.Number > 0 Then
MsgBox Target.Value & " はありません"
Else
Application.EnableEvents = False
Target.Offset(, 1) = 顧客名
Target.Offset(, 2) = WorksheetFunction.VLookup(Target.Value, Rang2, 12, 0)
Target.Offset(, 3) = WorksheetFunction.VLookup(Target.Value, Rang2, 18, 0)
Target.Offset(, 4) = WorksheetFunction.VLookup(Target.Value, Rang2, 20, 0)
Application.EnableEvents = True
End If
End Sub

エラーだった場合、メッセージボックスに入力した番号が出る、などは理想の動きなのですが・・・。

確かに、シート１の管理台帳にあること。
シート１とシート３の数字が両方文字列であること、は確認しました。
他に何か、思い当たることはないでしょうか・・・・？？

たびたび申し訳ありません。
よろしくお願いします。

回答No.2

myRange

回答１さんがお忙しいそうなので。。。

＞型が一致しません。　エラー’13
＞Set rang2 = Worksheets("管理台帳").Range("g4:X20").Value
＞の部分が黄色くなりました。

最後の、.Value　は不要です。

で、以下をコピペ、実行。

'-------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

　Dim Rang1 As Range
　Dim Rang2 As Range
　Dim 顧客名 As String
　Dim LastRow as Long

　If Intersect(Target, Rang1) Is Nothing Then Exit Sub

　LastRow = Worksheets("管理台帳").Cells(Rows.Count, "B").End(xlUp).Row
　Set Rang2 = Worksheets("管理台帳").Range("B5:X" & LastRow)
　Set Rang1 = Columns("K")

　　　On Error Resume Next

　顧客名 = WorksheetFunction.VLookup(Target.Value, Rang2, 2, 0)
　If Err.Number > 0 Then
　　MsgBox Target.Value & " はありません"
　Else
　　Application.EnableEvents = False
　　Target.Offset(, 1) = 顧客名
　　Target.Offset(, 2) = WorksheetFunction.VLookup(Target.Value, Rang2, 12, 0)
　　Target.Offset(, 3) = WorksheetFunction.VLookup(Target.Value, Rang2, 18, 0)
　　Target.Offset(, 4) = WorksheetFunction.VLookup(Target.Value, Rang2, 20, 0)
　　Application.EnableEvents = True
　End If
End Sub
'---------------------------------------------

変数宣言はできる限り型も宣言しておきましょう。
また、管理台帳のセル範囲は、
Range("B5:X20")のように５行目から２０行目と固定させるのではなく
上記のように最終行を捉まえるようにした方がいいでしょう。
以上です。

お礼

ありがとうございます。
　管理台帳のセル範囲は、おっしゃる通り、固定ではなく最終行にしたかったので、
これで大満足です。（自分でうまく設定できず、とりあえず20まで・・・、としてました。）

　作成していただいたものをコピペしてみたのですが、またエラーが出てしまいました・・・。

実行時エラー’５
プロシージャの呼び出し、または引数が不正です。

If Intersect(Target, Rang1) Is Nothing Then
の部分が黄色くなってしまいました・・・・。

自分なりに考えてみたのですが、わかりません。
お手数をおかけして申し訳ありませんが、またご教授いただけないでしょうか・・・・。

回答No.1

Masa2072

VLOOKUPワークシート関数のエラートラップを行いたいのだと思いますが

On Error Resume Next 'エラー発生時は次の行を評価

顧客名 = Application.WorksheetFunction.VLookup(Target.Value, rang2, 2, 0)
If Err > 0 Then
　Err.Clear 'エラー発生の場合は、次評価のためエラー番号をクリア
Else
　Target.Offset(, 1) = 顧客名
End If

という感じでいかがでしょうか

お礼

早々の回答、ありがとうございます。

On Error Resume Next
は、いろいろ調べている途中で出てきたのですが、どこに入れていいかがわかりませんでした。

今、こちらでためしてみたのですが、
エラーが出てしまいました。

型が一致しません。　エラー’13
Set rang2 = Worksheets("管理台帳").Range("g4:X20").Value
の部分が黄色くなりました。

他、どの部分を修正すればいいのか、わかりましたらお願いします。