エクセルで 複数のデータを検索して複数表示させたいのですが・・・。

質問

エクセルで在庫の場所がチェックできる下記のような物を作りたいと考えています。

在庫リスト　シート1
　　　　　　Ａ　　　　Ｂ　　　Ｃ　　
1行目　　商品名　　　色　　　場所
2行目　　あいう　　　赤　　　Ａ1
3行目　　かきく　　　黄　　　Ａ2
4行目　　さしす　　　青　　　Ａ3
5行目　　あいう　　　黄　　　Ａ4
6行目　　かきく　　　青　　　Ａ5
・
・
・
・

在庫リスト　シート2
　　　　　　Ａ　　　　Ｂ　　　Ｃ　　
1行目　　商品名　　　色　　　場所
2行目　　あいう　　　青　　　Ｂ1
3行目　　かきく　　　緑　　　Ｂ2
4行目　　さしす　　　桃　　　Ｂ3
5行目　　あいう　　　茶　　　Ｂ4
6行目　　かきく　　　桃　　　Ｂ5
・
・
・
・

上のような表を作成し、別のシート（シート3）で　検索名　あいう　と打ち込むと　

　赤　　Ａ１
　黄　　Ａ４
　青　　Ｂ１
　茶　　Ｂ４

という具合に同じ商品を検索し、色と場所を全て表示させるようなものをエクセルで作成できたらと思っています。可能でしょうか？また、可能であればどのような関数を使って作成したらよいのかを教えていただきたいです。vlookupが使えるかと思ったのですが、それだと一番上のデータ（この例でいけば　赤　Ａ１）のみの表示になってしまい、使えませんでした。

あと、欲を言えば、　商品名を全て打ち込みをしなくても、一部のみ（この例でいけば　「あいう」　ではなくて　「あい」のみ）を打ち込むだけでその字を含む商品名を検索し、表示してくれるような表記の仕方があるともっとありがたいです。在庫リストは在庫の場所ごとに複数のシートに分かれています。

よろしくお願いします。

回答No.6

id-sakura

Sub 商品検索()
Dim Shouhin As String　<----------------------------------Inputboxに入れる値を決める
Dim zaikoSheet As Worksheet<-----------------------------------それぞれのWorksheetをzaikosheetと決めた　　　　　
Dim kashiraMoji As String<-------------------------------------在庫リストの頭文字の値を決める
Dim i As Integer<-------------------------------------------1,2,3,と変化する値
Shouhin = Application.InputBox(prompt:="商品名を入力して下さい。", Title:="在庫検索")　<------------putboxに入れた値をとりだす
For Each zaikoSheet In Worksheets<-----------------------------すべてのシートに以下処理をする
If zaikoSheet.Name = "検索シート" Then　　
Exit For　<----------------------------------------------------もしシート名が"検索シート"になったら処理を止める
Else　 <------------------------------------------------それ以外は
i = 1 <--------------------------------------------------まず変化する値を1と決める
Do Until zaikoSheet.Cells(i + 2, "b").Value = ""<-------------シートのB列3行目以降のセルが空になるまで以下の処理を繰り返す
kashiraMoji = Left(zaikoSheet.Cells(i + 2, "b").Value, 1)<----KashiraMojiと言うのはB列3行目以降の左から1番目の文字だよと決めた
If kashiraMoji = Shouhin Then<-------------------------------頭文字と商品が同じだったらその時は
Worksheets("検索シート").Activate<----------------------------最後のシートをアクティブにして
Range("B2").End(xlDown).Offset(1).Value = zaikoSheet.Cells(i + 2, "b").Value　<---Ｂ列の表の一番最終行にヒットしたセルの値を入れる
Range("c2").End(xlDown).Offset(1).Value = zaikoSheet.Cells(i + 2, "c").Value<---C列の表の一番最終行にヒットしたセルの値を入れる
Range("d2").End(xlDown).Offset(1).Value = zaikoSheet.Cells(i + 2, "d").Value<---D列の表の一番最終行にヒットしたセルの値を入れる
Else <--------------------------------------------------------それ以外(頭文字と商品が違う場合)は何もしない
End If <------------------------------------------------------値がなくなったら終わりにして下さい
i = i + 1　<--------------------------------------------------- 1を２にして
Loop　　<-----------------------------------------------------繰り返す(Do untillの行へ戻る)
End If <-------------------------------------------------------シート名が検索シートなら終わる
Next　<--------------------------------------------------------シート名が検索シートでなければ次ぎのシートに進む
End Sub

私はマクロの初心者ですが質問のようなマクロだと簡単な記述で出来そうだったので作ってみました。もしかしたら何かの参考になるかと思い勉強も兼ねて作ってみました。　<------------------------以下は補足です。
上記のマクロだとシートが何枚あっても商品がいくつあっても頭文字を入れれば目的の物だけを表示します
"検索シート"は最後のシートにしてください(もちろん他の名前でも良いです)
とりあえず"検索シート"のＢ列の最終行を探してヒットした項目を書き出すようにしました

　　　　　Ｂ列　　 Ｃ列　　　Ｄ列
2行目　　 商品 色 場所 <------見だし行
3行目　　 ＊＊＊ ＊＊＊ ＊＊＊<--------------------- ここ表の2行めに何か入れていないと最終行を探し出して書き出してくれない