|
γさん
お世話になっております。
いつもご丁寧にありがとうございます。
早速、実践したところ上手くいきました。
大変助かりました。
ひとつ質問ですが、下記参考コードで
>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
|
|