VBA マクロの自動実行

Question

B3の番号に値を入力し、マクロを実行するとメーカー・製品名が反映される。（G～Iのデータを反映。）

B3に入力した際に、C6～E6を自動で反映されるようにしたい。
また、番号を削除したらメーカー・製品名が消えるようにしたい。
今は番号を消すときに、右下に入力されたものもいちいち手で消さないとならない。

スムーズにできる方法はありますでしょうか。

Sub if_jirei_1()
    If Range("B3").Value >= 100 And Range("B3").Value <= 499 Then
        Range("C6:E6").Value = Range("H6:J6").Value
    End If
    If Range("B3").Value >= 500 And Range("B3").Value <= 999 Then
        Range("C6:E6").Value = Range("H7:J7").Value
    End If
End Sub

Comments

[m.ts10806]

どういうときに「番号を消す」のでしょうか？そのイベントを取得して空を設定すれば良いですが、「消したいタイミング」によっては手動で消した方が早いかもしれません。「クリア」ボタンを設置する　あたりが現実的かとは思いますが、それも要件次第です。

[hatena19]

画像がリンク切れになってます。再度、アップロードしてください。

Answer 1

セルB3に、番号が入力されたり、削除されたりした時、マクロが自動で実行されればいいということですよね。（削除された時だけ、自動実行ではあまり意味ないと思いますので）

ワークシートのChange イベントを使えばいいでしょう。

Worksheet.Change イベント (Excel)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3")) Is Nothing Then Exit Sub
    Application.EnableEvents = False    
    Call if_jirei_1    
    Application.EnableEvents = True
End Sub

Sub if_jirei_1()
    If Range("B3").Value = "" Then
        Range("C6:E6").ClearContents
    ElseIf Range("B3").Value >= 100 And Range("B3").Value <= 499 Then
        Range("C6:E6").Value = Range("H6:J6").Value
    ElseIf Range("B3").Value >= 500 And Range("B3").Value <= 999 Then
        Range("C6:E6").Value = Range("H7:J7").Value
    Else
        MsgBox "100以上999以下の数値を入力してください。"
        Range("C6:E6").ClearContents
    End If
End Sub

追記

if_jirei_1は、Select Caseを使った方がシンプルで読みやすく記述できます。

Sub if_jirei_1()
    Select Case Range("B3").Value
    Case ""
        Range("C6:E6").ClearContents
    Case 100 To 499
        Range("C6:E6").Value = Range("H6:J6").Value
    Case 500 To 999
        Range("C6:E6").Value = Range("H7:J7").Value
    Case Else
        MsgBox "100以上999以下の数値を入力してください。"
        Range("C6:E6").ClearContents
    End Select
End Sub

追記2

さらに、言えば、参照範囲の番号列を検索(WorksheetFunction.Match等で)するようにすれば、
よりシンプルに記述できますし、参照範囲の番号が変更されても
コードを変更する必要はなくなり、より実用的です。

Sub if_jirei_2()
    Dim r As Long
    Select Case Range("B3").Value
    Case ""
        Range("C6:E6").ClearContents
    Case Else
        On Error Resume Next
        r = WorksheetFunction.Match(Range("B3"), Range("G6:G9"), 1)
        On Error GoTo 0
        If r = 0 Then
            MsgBox Range("G6").Value & "以上の数値を入力してください。"
        Else
            Range("C6:E6").Value = Range("H5:J5").Offset(r).Value
        End If
    End Select
End Sub

Comments

[退会済みユーザー]

詳細にありがとうございます。
スマホから操作で画像を間違って消してしまいました。
後ほど、アップいたします。

Answer 2

hatena19 さんの二番煎じですが、
SelectCase等の書き方で別バージョンを参考まで。

Sub if_jirei_1()
    Range("C6:E6").ClearContents
    Dim Val As Variant
    Select Case Range("B3").Value
    Case 100 To 499:  Val = Range("H6:J6").Value
    Case 500 To 999:  Val = Range("H7:J7").Value
    Case ""
        Exit Sub
    Case Else
        MsgBox "100以上999以下の数値を入力してください。"
        Exit Sub
    End Select
    Range("C6:E6").Value = Val 
End Sub

Comments

[退会済みユーザー]

ありがとうございます。
とても勉強になります。