Excel マクロ VBA 別シートのセルを検索し、該当するセルの右にあるセルを入力させる方法 s

Excel マクロ VBA 別シートのセルを検索し、該当するセルの右にあるセルを入力させる方法

sheet『品名マスタ』にはA列に№、B列に商品名があります。sheet『一覧』のB列7行目以降に№が入っています。
※この№が重複することはありません。

『一覧』B列7行目以降にある№で『品名マスタ』A列の№を検索し、該当する『品名マスタ』B列の商品名を『一覧』のC列7行目に反映する。
『一覧』B列の№が空欄の場合は何も入れない。

という処理のボタンをつけたいのですが、どなたか詳しい方ご教授いただけないでしょうか？
（OS：Windows7 Excel：2010を使用しております。）

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2016/11/21 11:46

こんにちは。

以下を試してみてください。

>処理のボタンをつけたい
マクロ名は任意です。Match関数を利用しています。

'//
Sub Button1_Click()　　'←ここは任意
Dim c, i
Dim Sh1 As Worksheet: Set Sh1 = Worksheets("一覧")
Dim Sh2 As Worksheet: Set Sh2 = Worksheets("品名マスタ")
With Sh1
　For Each c In .Range("B7", .Cells(Rows.Count, 2).End(xlUp))
　　If IsNumeric(c.Value) Then
　　　i = Application.Match(c.Value, Sh2.Columns(1), 0)
　　　If IsNumeric(i) Then
　　　　c.Offset(, 1).Value = Sh2.Cells(i, 2).Value
　　　End If
　　End If
　Next c
End With
End Sub

-----------
この種の質問では定番ですが、イベント・ドリブン型マクロがありますので、それも加えておきます。一覧のB列に数字を入れると、自動的に商品名が出てきます。Vlook関数とは似ていますが、違うのは、数字を消すと、右隣のセルの内容も消えます。

'//シートモジュール（シートタブを右クリック、コードの表示)

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim i As Variant '数値型ではありません
　Dim buf As String
　Dim Sh1 As Worksheet: Set Sh1 = Worksheets("品名マスタ")
　If Target.Count > 1 Then Exit Sub
　With Target
　If .Column <> 2 Then Exit Sub
　If .Row < 7 Then Exit Sub
　'数字を削除すると、隣の文字が消える
　If .Value = "" Then Target.Offset(, 1).ClearContents: Exit Sub
　　If IsNumeric(.Value) Then
　　　i = Application.Match(.Value, Sh1.Columns(1), 0)
　　　If IsNumeric(i) Then
　　　　buf = Sh1.Cells(i, 2).Value
　　　　Application.EnableEvents = False
　　　　.Offset(, 1).Value = buf
　　　　Application.EnableEvents = True
　　　　buf = ""
　　　End If
　　End If
　End With
End Sub

この回答へのお礼

出来ました！
大変勉強になりました。
ありがとうございます！

お礼日時：2016/11/21 17:17