助けてください。VLOOKUPやOFFSETでは解決できません（＞＜）

質問

助けてください。。
仕事でレシピを作成しているのですが、
メニュー名や材料、手順をデータとして入力をしていて、その中から必要に応じて3つぐらいのメニューを選んで別シートにレシピを作成をしています。
今までは、コピー、貼り付けをして対応してましたが、仕事量が増え、負担になってきているので、なんとか数式で簡単にデータを引っぱってこれないかなあと思っています。

データの入力は↓のようにしてあります。

　　　A　　　　　　　　　B　　　　　　　C

1　メニュー名　　　　　材料　　　　　　手順
2　ぶりしゃぶ　　　　　ぶり（薄切り）　(1)ぶりは
3　ぶりしゃぶ　　　　　ほうれん草　　　(2)次に
4　ぶりしゃぶ　　　　　酒　　　　　　　(3)ほうれ
5　ぶりしゃぶ　　　　　ポン酢　　　　　(4)最後に
6　きのこのホットパイ　きのこ　　　　　(1)パイシ
7　きのこのホットパイ　パイシート　　　(2)きのこ
8　きのこのホットパイ　ホワイトソース　(3)鍋に、　
9　きのこのホットパイ　白ワイン　　　　(4)オーブン
10　きのこのホットパイ　玉ねぎ　　　　　(5)皿に　
.
.
.
.

別シートには↓のように、A1セルにメニュー名を入力するとA4、B4以下に自動で入力されるようにしたいです。
材料は、4つとは限らず、2個の事も10個のこともあります。手順も同様です。また、材料の個数＝手順の行程数とは限りません。材料は2個なのに、手順は4行程ということもあります。

　　A　　　　　　　　　B
1　ぶりしゃぶ
2
3
4　ぶり（薄切り）　(1)ぶりは
3　ほうれん草　　　(2)次に
4　酒　　　　　　　(3)ほうれ
5　ポン酢　　　　　(4)最後に

VLOOKUPやOFFSETを使用して作ってみたのですが、うまくいきませんでした。HITする文字列が複数ある場合は、どのようにすればいいのでしょうか。。
是非ご教授頂ければと思っております。
よろしくお願い致します☆

回答No.4

shiotan99 · ベストアンサー

No.2です。

データシート → 料理データ最新
レシピシート → 料理教室用白紙、ですか？
で、レシピシートの B12セルにメニュー名を入力したら 16行目以下に材料・手順が表示されればいいんですよね。
手順は C列からK列まであるってこと？

データシートは 2行目からデータがあるとして、
▽ 料理データ最新シートの O2セルに
=IF(AND(料理教室用白紙!$B$12<>"",A2=料理教室用白紙!$B$12),ROW(),"")

と入れ、予想される最終データ行までフィルコピー
◆ なお、データの途中にあとから行を挿入して追加する場合は、忘れずにその行にも作業列の式をコピーしてください。

▽ 料理教室用白紙シートの B16セルに
=IF(COUNT(料理データ最新!$O:$O)<ROW(A1),"",INDEX(料理データ最新!B:B,SMALL(料理データ最新!$O:$O,ROW(A1))))

と入れて、右へ K16セルまでフィルコピー
B16：K16 の式を下に 10行分ぐらいフィルコピー

◆ 上の式をそのままコピー＆ペーストしてください。
こちらのテストデータではうまくいっているので、エラーが出るのは式の入力ミスとしか考えられません。
◆ それでもうまくいかないようでしたら、入力した式をコピーして提示してください。
*****
それと最初の質問の
>材料は2個なのに、手順は4行程ということもあります。

を見落としていました。
データシートの B列は空白だけれど C列以降にはデータがある、こともあるってことですよね。
手順のほうも全部が全部 K列まですべて入力するわけじゃないですよね。
G列まで手順が入力されていて、H列以降は空白のこともあるとか。

データシートが空白になっているところは、レシピシートでは 0が表示されるので、0を非表示にしたければ、
レシピシートの 16行目以下に数式を入れたセルをすべて選択して、
メニューの書式～セル～表示形式タブ
分類から 「ユーザー定義」を選び、右の種類ボックスに # とだけ入れてください。
これで 0は非表示になります。

または、数式の最後に &"" をつけても 0は表示されないと思います。
=IF(COUNT(料理データ最新!$O:$O)<ROW(A1),"",INDEX(料理データ最新!B:B,SMALL(料理データ最新!$O:$O,ROW(A1))))&""

以上、試してみてください！

お礼

ｓｈｉｏｔａｎ99様、お礼が遅くなってごめんなさい。
レシピ、ついに完成することができました！！
本当にありがとうございます！！
とっても楽で、仕事もはかどります☆
実は、、、仕事でこのような事（エクセル数式やマクロを使った業務改善）を要求される事がとても多く、自分に力がないので困る事も多きあります。（＞＜）　また、質問する事があると思いますので、その時はまたご教授いただけると嬉しいです☆
今回は本当にありがとうございました！！！

回答No.3

Wendy02

こんにちは。

本来、フィルターオプションで手動でも十分に可能なのですが、繰り返し使うことになると、マクロのほうが便利です。

コントロール・ツールのボタンやフォームツールのボタンに取り付けると便利かもしれませんね。

また、コンボボックスで、メニュー名を選べるようにすれば、もっと便利になります。

※シート名は、必要に応じて書き換えてください。
抽出先もしくはボタンをつける場合は、Sheet2側になります。データがあるほうが、Sheet1になっています。

'標準モジュール
Sub PickUpMacro()
'フィルターオプションを使ったマクロ
　 Dim myDatabase As Range
　 Dim myCriteria As Range
　 Dim myExtract As Range
　 Dim InputArea As Range
　 'データ範囲
　 Set myDatabase = Worksheets("Sheet1").Range("A1", _
　　　　　　　　　　Worksheets("Sheet1").Range("A1").End(xlDown).Offset(, 2))
　 '出力先
　 Set myExtract = Worksheets("Sheet2").Range("A4:B4")
　 '入力先
　 Set InputArea = Worksheets("Sheet2").Range("A1")

　 '検索条件（そこにデータがなければ動かす必要はありません。)
　 Set myCriteria = Worksheets("Sheet2").Range("D1:D2")
　 On Error Resume Next
　 With ThisWorkbook
　　 .Names("Criteria").Delete
　　 .Names("Database").Delete
　　 .Names("Extract").Delete
　 End With
　 On Error GoTo 0

　 Application.ScreenUpdating = False

　 myExtract.CurrentRegion.ClearContents
　 myCriteria.ClearContents

　 If InputArea.Value = "" Then MsgBox "検索値をいれてください。": Exit Sub

　 If WorksheetFunction.CountA(myCriteria) < 2 Then
　　　myCriteria.Cells(1, 1).Value = myDatabase.Cells(1, 1).Value
　　　myCriteria.Cells(2, 1).Value = InputArea.Value
　 End If

　　myExtract.Value = myDatabase.Range("B1:C1").Value

　 myDatabase.AdvancedFilter _
　　　　Action:=xlFilterCopy, _
　　　　CriteriaRange:=myCriteria, _
　　　　CopyToRange:=myExtract, _
　　　　Unique:=False
　 myCriteria.ClearContents
　 Application.ScreenUpdating = True

　　Set myDatabase = Nothing: Set myCriteria = Nothing
　　Set myExtract = Nothing: Set InputArea = Nothing

End Sub

なお、コントロールツールのコマンドボタンに取り付けるときは、以下のようにしてください。

'シートモジュール
Private Sub CommandButton1_Click()
　Call PickUpMacro
End Sub

回答No.2

shiotan99

こんにちは～

データシートが Sheet1
レシピシートが Sheet2 だとします。

■ 作業列を使わない方法 ■
Sheet2 の A4セルに
=IF(COUNTIF(Sheet1!$A$1:$A$100,$A$1)<ROW(A1),"",INDEX(Sheet1!B$1:B$100,100-LARGE(INDEX((Sheet1!$A$1:$A$100=$A$1)*100-ROW($A$1:$A$100),0),ROW(A1))))

と入れ（ ↑をそのままコピー＆ペーストしてください ）、
B4セルにフィルコピー
A4：B4 を必要なだけ下にフィルコピーしてください。

◆ データシートの最終行が 100行目と仮定しています。
それ以上ある場合は、数式の 100を修正してください。

■ 作業列を使う方法 ■

作業列はどの列でもかまいません。
ここでは仮に Sheet1 の F列を作業列にします。

Sheet1 の F2セルに
=IF(AND(Sheet2!$A$1<>"",A2=Sheet2!$A$1),ROW(),"")

と入れ、データ最終行までフィルコピー
今後もデータが増えつづけるなら多めにコピーしておいてください。

Sheet2 の A4セルに
=IF(COUNT(Sheet1!$F:$F)<ROW(A1),"",INDEX(Sheet1!B:B,SMALL(Sheet1!$F:$F,ROW(A1))))

と入れて、右の B4セルにフィルコピー
A4：B4 を必要なだけ下にフィルコピーしてください。

◆ 作業列が F列以外なら $F:$F（ 2ヶ所 ）をその列記号にしてください。
◆ 作業列が目障りなら非表示にしてください。
◆ データが多い場合は、作業列を使う方法をおすすめします。

お礼

早速のご回答ありがとうございます！　作業列を追加する方法で、試してみたのですが、うまくいきませんでした（＞＜）
作業列の方は、A1に対応するものに番号がふられてうまくいっているようなのですが、
レシピシートの方に表示されません。
ＩＮＤＥＸの所で、使用する引数を選択してくださいのＢＯＸが出て？？でしたし、ＩＦ関数の偽の部分が＃ＮＵＭ！赤字になってしまいました。私の訂正の仕方が多分おかしかったのだと思います。。

すみませんが、↓のようにしたいので、もう一度ご教授いただけますでしょうか？
よろしくお願い致します☆

シート名は、料理データ最新と料理教室用白紙で、
作業列はＯ、
メニュー名入力箇所はＢ12、
抽出箇所はＢ16～Ｋ16までで、
下に10行ぐらいフィルコピー。

回答No.1

papayuka

データの持ち方を工夫した方が良いでしょうね。

　ぶりしゃぶ材料　　ぶり（薄切り）　　ほうれん草　　酒
　ぶりしゃぶ手順　　(1)ぶりは　　　(2)次に　　(3)ほうれ

のようにして、A1に名称を入れた時に

　A4 では =VLOOKUP($A$1&"材料",データ範囲,2,0)
　A5 では =VLOOKUP($A$1&"材料",データ範囲,3,0)
　B4 では =VLOOKUP($A$1&"手順",データ範囲,2,0)
　B5 では =VLOOKUP($A$1&"手順",データ範囲,3,0)

あとは、IFやISERROR 又は ISNA等併用して、データが無い場合は空白表示にさせます。

データ構造がそのままなら、VBAでやっちゃうとか。
試すなら新規シートで。

１）レシピのシート名 を「レシピ」、データのシート名 を「データ」とします。
２）データシートはA1から始まるタイトルありの表で、A列のデータでソートされているとします。
３）レシピシートのシート名タブを右クリックし、コードの表示で出てきたVBE画面に下記のコードを貼り付けます。
４）レシピシートのA1を入力すると切り替わります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, cnt As Long
　If Target.Cells(1, 1).Address <> "$A$1" Then Exit Sub
　Worksheets("レシピ").Range("A4").CurrentRegion.ClearContents
　cnt = 4
　　With Worksheets("データ")
　　　For Each r In .Range(.Range("A1"), .Range("A65536").End(xlUp))
　　　　If r.Text = Target.Cells(1, 1).Text Then
　　　　　 Worksheets("レシピ").Range("A" & cnt).Value = r.Offset(0, 1).Text
　　　　　 Worksheets("レシピ").Range("B" & cnt).Value = r.Offset(0, 2).Text
　　　　　 cnt = cnt + 1
　　　　End If
　　　Next r
　　End With
End Sub