エクセルで条件1つで、複数の値を抽出することできますか？

質問

加工作業の日報をエクセルでつけているのですが、品名と、それに使う資材をあるシートにマスターテーブルとして登録してあるのを前提に、日報のシートで、以下の作業を自動的にでるようにできますでしょうか？
★マスターシート：
　　A　　　B
品名　　　資材名　　←項目名
FD　　　　シール
FD　　　　FDケース
FD　　　　FD本体
FD　　　　箱
CD-R　　　シール
CD-R　　　CDケース
CD-R　　　CD本体　　
・　　　　　・
・　　　　　・
★日報シート：
　　A　　　B
　FD　　　シール　　　←例えば、このA1にFDと入力すると、
　　　　　FDケース　　　　B1～B4に資材が出る
　　　　　FD本体　　　　　A5にCD-Rと入れると、B5～B7に
　　　　　箱　　　　　　　その資材が出る

いろいろ検索してみたのですが、知りたいことを見つけることができなかったので、質問します。
関数でできれば一番良いのですが、VBAでもかまいません。

どうかよろしくお願いします。

回答No.2

nishi6 · ベストアンサー

補足の３つの点について変更してみました。コードの説明も追記してみました。
ご参考に。

Const inpCol = 2 '***入力する列。Ｂ列(2番目)の例
Const outCol = 5 '***出力する列。Ｅ列(5番目)の例

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　　Dim rw As Long '行カウンタ
　　Dim FoundArea As Range 'Sheet2の検索範囲
　　Dim FoundData As Range 'Sheet2で見つけた品名のセル

　　'====================================================
　　'エラーが起きたら、処理ルーチンに飛んで終了させています
　　'====================================================
　　On Error GoTo ErrorHandler 'エラー対応

　　'=============================================================
　　'Targetは入力セルになります。ただし、変更を一括で行ったりする場合、
　　'予期せぬ編集をする可能性があるので、単一セルの入力の場合に限定しています
　　'=============================================================
　　If Target.Count = 1 Then '単一セルへの処理の場合
　　　　'==========================================================
　　　　'指定した列に入力した時のみ次のIf文に入ります。
　　　　'この場合はinpColは２なので、Ｂ列に入力があった場合になります。
　　　　'==========================================================
　　　　If Target.Column = inpCol Then '***指定した入力列に入力した場合
　　　　　　'=========================================================
　　　　　　'入力セルからOffsetで列を<outCol - inpCol>分右に行ったセルに
　　　　　　'何か入力があったら次のIf文が実行されます。
　　　　　　'<outCol - inpCol>は３で、３、４列分右を調べています。
　　　　　　'=========================================================
　　　　　　If Target.Offset(0, outCol - inpCol) <> "" Or _
　　　　　　　　Target.Offset(0, outCol - inpCol + 1) <> "" Then
　　　　　　　　'入力の右セルまたはもう１つ右に入力があれば処理不可にする
　　　　　　　　MsgBox "入力位置が不正です。この入力に対する処理は中断します"
　　　　　　　　'=========================================================
　　　　　　　　'入力したセルの値を消しています。しかし、直接消しに行くと
　　　　　　　　'消すことで再度Worksheet_Changeが起きるため、イベントが
　　　　　　　　'起きないようにして消去して、イベントが起きるように戻しています
　　　　　　　　'=========================================================
　　　　　　　　Application.EnableEvents = False
　　　　　　　　Range(Target.Address) = "" '入力を無効にする
　　　　　　　　Application.EnableEvents = True
　　　　　　　　Exit Sub
　　　　　　End If

　　　　　　With Worksheets("Sheet2")
　　　　　　　　'入力値を検索する
　　　　　　　　'=================================================================
　　　　　　　　'入力値を検索するSheet2の範囲を決めています。
　　　　　　　　'A1から入力された最後の行までを対象にしますが、
　　　　　　　　'最後の行を、一番下の行から上に向かって、登録された最初の行にしています
　　　　　　　　'=================================================================
　　　　　　　　Set FoundArea = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
　　　　　　　　'====================================================================
　　　　　　　　'Findを使って検索しています。これで入力値と一致する最初のセルが分かります。
　　　　　　　　'検索条件は、入力値と一致、A1から検索開始、全部が一致
　　　　　　　　'　大文字・小文字を区別（今回追加）にしています。
　　　　　　　　'====================================================================
　　　　　　　　Set FoundData = FoundArea.Find(What:=Target.Text, _
　　　　　　　　　　　　　　　　After:=Range("A1"), LookAt:=xlWhole, MatchCase:=True)

　　　　　　　　'値が合致したら
　　　　　　　　'===============================================
　　　　　　　　'検索して一致する値があったら次のIf文を実行する
　　　　　　　　'===============================================
　　　　　　　　If Not (FoundData Is Nothing) Then
　　　　　　　　　　'***連続で入力されている資材名を抽出する。隣の列を追加
　　　　　　　　　　'====================================================
　　　　　　　　　　'入力セルから<outCol - inpCol>分右のセルに資材名を表示
　　　　　　　　　　'今回、その隣にもう１項目表示するよう追加
　　　　　　　　　　'====================================================
　　　　　　　　　　Target.Offset(0, outCol - inpCol) = FoundData.Offset(0, 1)
　　　　　　　　　　Target.Offset(0, outCol - inpCol + 1) = FoundData.Offset(0, 2) '***
　　　　　　　　　　'=========================================================
　　　　　　　　　　'品名が一致している間、資材名とその隣のセルの値を転記している
　　　　　　　　　　'=========================================================
　　　　　　　　　　While Target.Text = FoundData.Offset(rw + 1, 0)
　　　　　　　　　　　　Target.Offset(rw + 1, outCol - inpCol) = FoundData.Offset(rw + 1, 1)
　　　　　　　　　　　　Target.Offset(rw + 1, outCol - inpCol + 1) = FoundData.Offset(rw + 1, 2) '***
　　　　　　　　　　　　rw = rw + 1
　　　　　　　　　　Wend
　　　　　　　　End If
　　　　　　End With
　　　　End If
　　End If

　　Exit Sub

ErrorHandler:
　　'===================================================================
　　'エラーが発生した場合、イベントが起きない状態で起きたかもしれないので
　　'イベントが起きるよう再度設定している
　　'===================================================================
　　Application.EnableEvents = True
End Sub

お礼

お礼が遅くなり、すみません！
ずっと、コードを、一文一文理解しようといろいろ調べながら確かめていたので、
遅くなりました。
なんとか、自分の使いたい表に合わせることができました。
本当に、丁寧に解説していただき、ありがとうございます。

nishi6さんが答えた、他の質問に対する回答などを参考にさせてもらって、
今、勉強しているところです。
本当にありがとうございました！<(_ _)>

回答No.1

nishi6

関数でもできなくはないと思いますが、日報シートの使用方法が明確でないこと、関数とVBAでどちらが簡単か対比をしてコードを書いてみました。
入力に対する出力行数が不定な点、入力を修正した場合の対応の困難さから、ユーザー定義関数を含めて、関数で対応するのは大変だと思います。

ツール→マクロ→Visual Basic Editor でVBE画面に移動し、Sheet1のコードウインドウに下記コードを貼り付けます。
シート２（コード内のシート名：Sheet2）をマスターシートとして、質問にあるように１行目から、項目名、データ・・・の順に入力します。

シート１（コード内のシート名：Sheet1）のＡ列に入力すると該当する資材名を表示します。
既にＢ列に資材名が表示されたＡ列の行には入力できません。修正する場合は先にＢ列を消します。
コード内のSheet2は実際のシート名に変更してかまいません。

ここから
↓
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
　　Dim rw As Long　　　　　　　　　　'行カウンタ
　　Dim FoundArea As Range　　　　　　'Sheet2の検索範囲
　　Dim FoundData As Range　　　　　　'Sheet2で見つけた品名のセル

　　On Error GoTo ErrorHandler　　　　'エラー対応

　　If Target.Count = 1 Then　　　　　'単一セルへの処理の場合
　　　　If Target.Offset(0, 1) <> "" Then
　　　　　　'入力の右セルに入力があれば処理不可にする
　　　　　　MsgBox "入力位置が不正です。この入力に対する処理は中断します"
　　　　　　Application.EnableEvents = False
　　　　　　Range(Target.Address) = ""　　　　'入力を無効にする
　　　　　　Application.EnableEvents = True
　　　　　　Exit Sub
　　　　End If
　　　　If Target.Column = 1 Then　　　　　　　'A列に入力した場合
　　　　　　With Worksheets("Sheet2")
　　　　　　　　'入力値を検索する
　　　　　　　　Set FoundArea = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
　　　　　　　　Set FoundData = FoundArea.Find(What:=Target.Text, _
　　　　　　　　　　　　　　　　　　　　　　After:=Range("A1"), LookAt:=xlWhole)

　　　　　　　　'値が合致したら
　　　　　　　　If Not (FoundData Is Nothing) Then
　　　　　　　　　　'連続で入力されている資材名を抽出する
　　　　　　　　　　Target.Offset(0, 1) = FoundData.Offset(0, 1)
　　　　　　　　　　While Target.Text = FoundData.Offset(rw + 1, 0)
　　　　　　　　　　　　Target.Offset(rw + 1, 1) = FoundData.Offset(rw + 1, 1)
　　　　　　　　　　　　rw = rw + 1
　　　　　　　　　　Wend
　　　　　　　　End If
　　　　　　End With
　　　　End If
　　End If

　　Exit Sub

ErrorHandler:
　　Application.EnableEvents = True
End Sub

補足

ありがとうございます！
これは、資材の在庫表を作っています。
それで、毎日数種類の品の加工作業（数種類の資材を使って１つの品ができる）をして、出荷するのですが、品名が多いこと、資材はいくつかの品名で共通のものがあること、品名によって同じ資材でも使う数が違うこと、などから、今日作成した品名に使った資材が、何か？数は？というのを入力するのに時間がかかっていたのです。
おおまかな構造では、日報シートに毎日その日に使った資材、入庫したもの、不良などを入力して、在庫表シートに資材ごとの在庫数などが計算されるというものを作っています。

私には、作っていただいたコードの内容をすべて理解するのはまだできないのですが、使ってみたところ、すごく思い通りのことができて、感激しています。
本当にありがとうございます。
そこで、もしできれば、以下の３つの点について、教えていただけたらと思うのですが・・・。
1.　右隣に入力されているセルには入力できないようになっている設定を、この場合、A、B列に限定するにはどうすればよいか。
2.　品名を入力する列を他の列にしたり、抽出された資材を他の列に出すにはどうすればよいでしょうか？
3.　マスターの資材名の横にもう１つ項目を足して、それも一緒に抽出することできますでしょうか？
★マスターシート：
品名　　　資材名　　　使用数
FD　　　　ケース　　　1　　　　←この1品に使う資材の数
　　　　　シール　　　2

・・・すみません、思っていたよりずっとさっぱりしたコードで、どういう指示をどこに記述してあるのか、わからなくて、自分で使うにはどこを変えればよいのかわかりませんでした・・・。
質問するに当たって、やりたいことだけを簡潔にお願いしたので・・・。

どうか、時間のある時でかまいませんので、解説お願いできたら・・・と思います。