Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
632 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【79342】VLOOKUPエラー回避 ちゃぷ 17/8/1(火) 22:02 質問[未読]
【79344】Re:VLOOKUPエラー回避 γ 17/8/1(火) 23:15 回答[未読]
【79345】Re:VLOOKUPエラー回避 ちゃぷ 17/8/2(水) 10:04 質問[未読]
【79346】Re:VLOOKUPエラー回避 γ 17/8/2(水) 12:45 回答[未読]
【79347】Re:VLOOKUPエラー回避 ちゃぷ 17/8/2(水) 18:48 お礼[未読]
【79348】Re:VLOOKUPエラー回避 γ 17/8/2(水) 21:11 発言[未読]
【79342】VLOOKUPエラー回避
質問  ちゃぷ  - 17/8/1(火) 22:02 -
引用なし
パスワード
   下記のコードを使用していますが、G列に記載した数字が
参照先(消耗品)に無い場合、#N/Aとなり、困っています。
出来れば、参照先に無い場合、「該当なし」というメッセージと
キャンセル状態もしくは空欄のままとしたいのですが、
さっぱり上手くいきません。

ご教授の程、宜しくお願い致します。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim rng As Range
　　Dim r　 As Range
　 Set rng = Intersect(Target, Range("$G$9:$G$600"))
　　If Not rng Is Nothing Then
　　Application.EnableEvents = False
　　　　For Each r In rng
　　　　　　If r.Value <> "" Then
　　　　　　　　r.Offset(, -2).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 2, False)
　　　　　　　　r.Offset(, -1).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 3, False)
　　　　　　　　r.Offset(, 1).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 4, False)
　　　　　　　　r.Offset(, 2).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 5, False)
　　　　　　　　r.Offset(, 3).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 6, False)
　　　　　　　　r.Offset(, 4).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 7, False)
　　　　　　　　r.Offset(, 6).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 8, False)
　　　　　　　　r.Offset(, 8).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 9, False)
　　　　　　　　r.Offset(, 12).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 10, False)
　　　　　　　　r.Offset(, 13).Value = Application.VLookup(r, Sheets("消耗品").Range("$B$3:$L$200"), 11, False)
　　　　　　Else
　　　　　　　　r.Offset(, -2).ClearContents
　　　　　　　　r.Offset(, -1).ClearContents
　　　　　　　　r.Offset(, 1).ClearContents
　　　　　　　　r.Offset(, 2).ClearContents
　　　　　　　　r.Offset(, 3).ClearContents
　　　　　　　　r.Offset(, 4).ClearContents
　　　　　　　　r.Offset(, 6).ClearContents
　　　　　　　　r.Offset(, 8).ClearContents
　　　　　　　　r.Offset(, 12).ClearContents
　　　　　　　　r.Offset(, 13).ClearContents
　　　　　　End If
　　　　Next
　　　　Application.EnableEvents = True
　　　　Set rng = Nothing
　　End If
End Sub
【79344】Re:VLOOKUPエラー回避
回答  γ  - 17/8/1(火) 23:15 -
引用なし
パスワード
   下記のコードを参考にしてみては？

ポイントは、
(1)Application.Match はマッチしないとき、エラーで止まらないが、
　 エラー値を返すので、IsError(m) で判定するとよい。
　 ht tps://www.moug.net/tech/exvba/0100035.html
　 を参考に。
(2)毎回毎回 Lookupでマッチするかどうか実行するのは無駄。
　 一度だけMatch を実行し、あとは、Indexで取得すればよい。
　 行番号と列番号を使って Cellsで指定しても可。
　　　
参考コード：

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim myRange As Range
　　Dim rng　　 As Range
　　Dim r　　　 As Range
　　Dim m　　　 As Variant

　　Set rng = Intersect(Target, Range("$G$9:$G$600"))

　　If rng Is Nothing Then Exit Sub
　　
　　Application.EnableEvents = False
　　Set myRange = Sheets("消耗品").Range("$B$3:$L$200")

　　For Each r In rng
　　　　If r.Value <> "" Then
　　　　　　m = Application.Match(r, Sheets("消耗品").Range("$B$3:$B$200"), 0)
　　　　　　If Not IsError(m) Then
　　　　　　　　r.Offset(, -2).Value = Application.Index(myRange, m, 2)
　　　　　　　　r.Offset(, -1).Value = Application.Index(myRange, m, 3)
　　　　　　　　r.Offset(, 1).Value = Application.Index(myRange, m, 4)
　　　　　　　　' 以下略
　　　　　　Else
　　　　　　　　MsgBox r.Value & "　は消耗品シートに該当コードなし"
　　　　　　　　Application.EnableEvents = True
　　　　　　　　Exit Sub
　　　　　　End If
　　　　Else
　　　　　　'そのまま残しました。
　　　　　　r.Offset(, -2).ClearContents
　　　　　　r.Offset(, -1).ClearContents
　　　　　　r.Offset(, 1).ClearContents
　　　　　　r.Offset(, 2).ClearContents
　　　　　　r.Offset(, 3).ClearContents
　　　　　　r.Offset(, 4).ClearContents
　　　　　　r.Offset(, 6).ClearContents
　　　　　　r.Offset(, 8).ClearContents
　　　　　　r.Offset(, 12).ClearContents
　　　　　　r.Offset(, 13).ClearContents
　　　　End If
　　Next
　　Application.EnableEvents = True
　　Set rng = Nothing
End Sub
【79345】Re:VLOOKUPエラー回避
質問  ちゃぷ  - 17/8/2(水) 10:04 -
引用なし
パスワード
   γさん

お世話になっております。
いつもご丁寧にありがとうございます。
早速、実践したところ上手くいきました。
大変助かりました。

ひとつ質問ですが、下記参考コードで
>If rng Is Nothing Then Exit Sub
に対するend ifが無いのはどうしてでしょうか。
試しに、end ifを入れるとエラーが出てしまいます。
初歩的な質問で申し訳ございませんが、
ご教授の程、宜しくお願い致します。


▼γ さん：
>下記のコードを参考にしてみては？
>
>ポイントは、
>(1)Application.Match はマッチしないとき、エラーで止まらないが、
>　 エラー値を返すので、IsError(m) で判定するとよい。
>　 ht tps://www.moug.net/tech/exvba/0100035.html
>　 を参考に。
>(2)毎回毎回 Lookupでマッチするかどうか実行するのは無駄。
>　 一度だけMatch を実行し、あとは、Indexで取得すればよい。
>　 行番号と列番号を使って Cellsで指定しても可。
>　　　
>参考コード：
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>　　Dim myRange As Range
>　　Dim rng　　 As Range
>　　Dim r　　　 As Range
>　　Dim m　　　 As Variant
>
>　　Set rng = Intersect(Target, Range("$G$9:$G$600"))
>
>　　If rng Is Nothing Then Exit Sub
>　　
>　　Application.EnableEvents = False
>　　Set myRange = Sheets("消耗品").Range("$B$3:$L$200")
>
>　　For Each r In rng
>　　　　If r.Value <> "" Then
>　　　　　　m = Application.Match(r, Sheets("消耗品").Range("$B$3:$B$200"), 0)
>　　　　　　If Not IsError(m) Then
>　　　　　　　　r.Offset(, -2).Value = Application.Index(myRange, m, 2)
>　　　　　　　　r.Offset(, -1).Value = Application.Index(myRange, m, 3)
>　　　　　　　　r.Offset(, 1).Value = Application.Index(myRange, m, 4)
>　　　　　　　　' 以下略
>　　　　　　Else
>　　　　　　　　MsgBox r.Value & "　は消耗品シートに該当コードなし"
>　　　　　　　　Application.EnableEvents = True
>　　　　　　　　Exit Sub
>　　　　　　End If
>　　　　Else
>　　　　　　'そのまま残しました。
>　　　　　　r.Offset(, -2).ClearContents
>　　　　　　r.Offset(, -1).ClearContents
>　　　　　　r.Offset(, 1).ClearContents
>　　　　　　r.Offset(, 2).ClearContents
>　　　　　　r.Offset(, 3).ClearContents
>　　　　　　r.Offset(, 4).ClearContents
>　　　　　　r.Offset(, 6).ClearContents
>　　　　　　r.Offset(, 8).ClearContents
>　　　　　　r.Offset(, 12).ClearContents
>　　　　　　r.Offset(, 13).ClearContents
>　　　　End If
>　　Next
>　　Application.EnableEvents = True
>　　Set rng = Nothing
>End Sub
【79346】Re:VLOOKUPエラー回避
回答  γ  - 17/8/2(水) 12:45 -
引用なし
パスワード
   一行ですむ場合は、そう書くのが決まりだからです。
ヘルプを読んで下さい。
If にカーソルを持って行ってF1キーを押します。
【79347】Re:VLOOKUPエラー回避
お礼  ちゃぷ  - 17/8/2(水) 18:48 -
引用なし
パスワード
   γさん

この度は有難うございました。
勉強になりました。

▼γ さん：
>一行ですむ場合は、そう書くのが決まりだからです。
>ヘルプを読んで下さい。
>If にカーソルを持って行ってF1キーを押します。
【79348】Re:VLOOKUPエラー回避
発言  γ  - 17/8/2(水) 21:11 -
引用なし
パスワード
   解決できたようで何より。

ひとつだけお願いがあります。
今度質問されるときは、逐一、他人の発言を
全文引用するようなことは避けてください。

引用しなくても直ぐ上に表示されているわけですし、
引用してそれについてコメントしているわけでもないですね。
全く無駄です。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
632 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free