タグを作りたいのです

質問

料理に関するもので仕込み表を作成したいのです。次のようなものをエクセルで作成したいのですが、どのようにしたらよいでしょうか？

１．Ｓｈｅｅｔ１に日付、時間、席名、会場名、人数、宴会形式を入力するようにする。Ｂ列にアルファベットでＡ、Ｂ、Ｃ、・・・と３行一組でメニュー名とその付け合せ、必要数を入れるようにします。このシートではＢ列にアルファベットＡ～Ｌまで１２種類の料理とその付け合せ、必要数が入力できるようにしています。
料理人はこれを見て仕込みをするようにしています。

２．これを踏まえて、Ｓｈｅｅｔ２に仕込んだ食材がどの宴会のどのメニューに使う物なのか判る様にタグを印刷して貼り付けられるようにしたいのです。
タグには日付、時間、席名、人数、宴会形式、メニュー名、付け合せ、必要数を反映させ、Ｓｈｅｅｔ１で空白になっている場合は順に詰めるようにするにはどのようにしたらよいでしょうか？タグはＡ４用紙に横３Ｘ縦６作成しています。
どなたかアドバイスお願いいたします。

回答No.1

ASIMOV · ベストアンサー

＞Ｓｈｅｅｔ１で空白になっている場合は順に詰める

この↑事と
材料の並びが、途中に結合セルが有る事により
かなり複雑な関数を組まないと出来ないと思います

それで、ＶＢＡでやってみました

Sheet2のタグの位置関係がよく判らないのですが、一応次の様にしました
　タグ１の左上のセルはB1
　タグは右に５列、下に７行づつずれる
　日付、宴会名、形式、人数は位置が決まっているので、コピーする
　（例：Sheet2のB1は =Sheet2!F3 とする）
したがって、このＶＢＡは、MENU名、材料名、材料数のみを並べてコピーします

以下のVBAを「標準モジュール」で実行します
---------------
Sub Mc1()
　　Dim Zai(6)
　　Dim Suu(6)
　　zl = 8
　　s2wsNo = 1
　　Sheet1.Select
　　Do Until Cells(zl, "C") = ""
' Sheet1 読み込み
　　　　rn = Cells(zl, "C")
　　　　For i = 1 To 6
　　　　　　Zai(i) = ""
　　　　　　Suu(i) = ""
　　　　Next
　　　　Do
　　　　　　If Cells(zl + 1, "C") <> "" Then
　　　　　　　　Zai(1) = Cells(zl + 1, "C")
　　　　　　　　Suu(1) = Cells(zl + 2, "C")
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　If Cells(zl + 1, "D") <> "" Then
　　　　　　　　Zai(2) = Cells(zl + 1, "D")
　　　　　　　　Suu(2) = Cells(zl + 2, "D")
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　If Cells(zl + 1, "E") <> "" Then
　　　　　　　　Zai(3) = Cells(zl + 1, "E")
　　　　　　　　Suu(3) = Cells(zl + 2, "E")
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　If Cells(zl + 1, "G") <> "" Then
　　　　　　　　Zai(4) = Cells(zl + 1, "G")
　　　　　　　　Suu(4) = Cells(zl + 2, "G")
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　If Cells(zl + 1, "I") <> "" Then
　　　　　　　　Zai(5) = Cells(zl + 1, "I")
　　　　　　　　Suu(5) = Cells(zl + 2, "I")
　　　　　　Else
　　　　　　　　Exit Do
　　　　　　End If
　　　　　　Exit Do
　　　　Loop
' Sheet2 書込み
　　　　Sheet2.Select
　　　　dNo = 1
　　　　Do Until Zai(dNo) = ""
　　　　　　c = ((s2wsNo + 2) Mod 3)
　　　　　　l = Int((s2wsNo - 1) / 3)
　　　　　　Cells(l * 7 + 4, c * 5 + 2) = rn
　　　　　　Cells(l * 7 + 5, c * 5 + 2) = Zai(dNo)
　　　　　　Cells(l * 7 + 5, c * 5 + 5) = Suu(dNo)
　　　　　　dNo = dNo + 1
　　　　　　s2wsNo = s2wsNo + 1
　　　　Loop
　　　　zl = zl + 4
　　　　Sheet1.Select
　　Loop
End Sub
---------------------

お礼

ASIMOV様

ご回答有難うございます。
Excelに関してはほとんど初心者なのでＶＢＡはまったくわからないのですが、コピペで何とかなりました。
お陰様で労働時間の短縮につながります。
有難うございました。