Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

3030 / 76735

←次へ　｜　前へ→


	【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