エクセルVBAで献立自動化、栄養士さんお助けツール、テクニック集第四回

献立自動化集　第四回目
プログラム
ダウンロード

献立自動化集　第四回目

前回までのレビュー

■　献立表の任意のセルをダブルクリックしたとき、フォームを表示してリストビューに作成済みのレシピのリストを表示し、任意のレシピを選択すると、そのレシピ名が週間献立表に転記するように設定しました。

詳しくは下のカードから参照してください

エクセルVBAで献立自動化、栄養士さんお助けツール、テクニック集、献立自動化第三回

献立自動化第３回目これまでのレビュー ■　週間献立表の枠組みを作成 ■　献立表の任意のセルをダブルクリックしたとき、レシピの一覧を表示するフォームを表示詳しくは下のカードから参照してくださいレシピデータの抽出...

週間献立表のメニュー名から食材情報を作業指示書に書き出す

■　Sheet２（献立作業指示書）の枠組みを作成します。

■　前回の献立表に埋め込んだレシピ名の食材情報をSheet2の所定のセルに書き出す処理を考えます。

下図のように、とりあえず月曜日だけメニューを設定しました

Sheet2を追加して下図のような献立作業指示書を作ってみました。ここに食材情報をかきだします。

週間献立表の右上にある　転送　ボタンをクリックすると下図のように、食材情報が書き出されました。

ここでは私のPC画面の制約上エクセルの表示画面で50行程度しか表示されていませんが、実際はスクロールして夕食部分までちゃんと書き出されています。

動作説明

■　レシピ番号を取得

週間献立表にレシピ名が埋め込まれると同時にそのセルの右側20列目にシフトしたセル（がめんから見えない位置）にレシピ名に対応したレシピ番号が記入されるようになっています。

献立表の月曜日の朝食、主食の行でセルがD6に「ごはん」が記入されているので、その右20列目は下のように表します

Sheet1.Cells(６, “D”).Offset(0, 20)

■　レシピ番号で、食材情報を取得

レシピ作成システムrecipe2でレシピを作成するとそのレシピ管理情報CSVと食材詳細情報CSVファイルが自動的に作成されます。それぞれレシピ番号で紐づいています。各CSVファイルからレシピ番号で選択したリストを配列変数にして取り出します。

■配列データを作業指示書シートに書き出します。

以上が大まかな処理の流れになります

つぎは具体的なプログラムになります。

プログラム

週間献立表右上の転送ボタンのクリック処理です。

朝食から夕食まで４個の食事区分帯に分かれていて更に各食事区分は１～７行の料理区分に分かれています。例えば朝食区分は主食、主菜、副菜、汁物、その他（予備用）となっていて、それぞれにレシピ名が割り振られているので、食事区分ごとにFunction katrgoriInputを呼び出してその中で料理区分の繰り返しを処理しています。

普通、このような処理ではSubプロシージャを使いますが今回は、食事区分の処理ごとに前の区分の最後の処理行の行位置を知る必要があるのでファンクションプロシージャを使って一番最終行位置を持ち帰るようにしました。

Private Function katrgoriInput(gyouRow As Integer, kubunIti As Integer, kubunSuu As Integer, syokusuIti As Integer, youbiretu As Integer) As Integer
'
'第一引数　Sheet２（献立指示書）で、データ書き込みの先頭行位置
'第二引数　Sheet１（週間献立表）で、C列の食事カテゴリーごとの先頭行位置
'第３引数　Sheet１（週間献立表）で、C列の食事カテゴリーが何行あるか行数を指定
'第４引数　Sheet３（食数表）で、食事帯ごと食数の指定　行　位置
'第５引数　Sheet３（食数表）で、食事帯ごと曜日の指定　列　位置
'
Dim r As Integer, i As Integer
Dim r2 As Integer, i2 As Integer
Dim resiNumb As Integer
Dim resiData As Variant
Dim resiKanri As Variant
Dim syokukubun As String
Dim syokusuu As Integer
Dim konkubun As String
Dim menumei As String
Dim gyousuu As Integer
Dim jun As Variant


''レシピ管理とdataの二次元配列を作る

'朝食
'食事区分、献立区分、食数、メニュー名　をsheet2に書き出す
With Sheet1
    syokukubun = .Cells(kubunIti, "A").Value
    syokusuu = Sheet3.Cells(syokusuIti, youbiretu).Value
    Sheet2.Cells(gyouRow, "A") = syokukubun
    Sheet2.Cells(gyouRow, "B") = syokusuu

    gyousuu = 0
    
    For r = 0 To kubunSuu - 1
        'レシピ番号をキャッチ
        resiNumb = Sheet1.Cells(r + kubunIti, "D").Offset(0, 20).Value
        
        '食事区分は最大が昼食７行あるが、データのない空白行が含まれるので注意
        If resiNumb <> 0 Then
            '詳細データを取り出す
            resiData = call_resipiData(resiNumb)    'Sheet1のすべての栄養価データと管理部分のデータも含まれる
            '管理データをレシピ番号で探して取り出す
            resiKanri = call_resipiKanri(resiNumb)
            'レシピ番号から行数をキャッチ
            gyousuu = resiKanri(10)
        
            '献立区分を転記
            konkubun = .Cells(r + kubunIti, "C").Value
            Sheet2.Cells(gyouRow, "C") = konkubun
            'メニュー名転記
            menumei = .Cells(r + kubunIti, "D").Value
            Sheet2.Cells(gyouRow, "D") = menumei
            '詳細データ転記
            '列データ順（別名、使用量、単位、規格、加工、業者,備考）
            jun = Array(64, 65, 66, 70, 72, 71, 63)
            Dim tobi As Integer
            Dim atai As String
            Dim gsuu As Integer
            Dim tanni As String
            tobi = 0
            On Error Resume Next
            For r2 = 0 To gyousuu - 1
                For i2 = 0 To 6
                   If i2 = 2 Then
                        '単位当たりｇ数が不明の時は1000ｇとみなす（調理用水）
                        If resiData(r2, 67) = "" Then
                            gsuu = 1000
                        Else
                            gsuu = resiData(r2, 67)
                        End If
                                                                '  使用量ｇ　   ×　食数　   ÷　 単位当たりｇ数
                        Sheet2.Cells(gyouRow + r2, i2 + 5) = resiData(r2, 65) * syokusuu / gsuu
                        tobi = tobi + 1
                        If resiData(r2, jun(i2)) = "" Then
                            If resiData(r2, 65) = "" Then
                                tanni = ""
                            Else
                                tanni = "kg"
                            End If
                        Else
                            tanni = resiData(r2, jun(i2))
                        End If
                        Sheet2.Cells(gyouRow + r2, i2 + 5 + tobi) = tanni
                    Else
                        If resiData(r2, jun(i2)) = "" And i2 = 0 Then
                            atai = resiData(r2, 5)
                        Else
                            atai = resiData(r2, jun(i2))
                        End If
                        Sheet2.Cells(gyouRow + r2, i2 + 5 + tobi) = atai
                    End If
                Next i2
                tobi = 0
            Next r2
            gyouRow = gyouRow + gyousuu + 1
        End If
        Call keisenTop2(gyouRow)    '食カテゴリーの変わり目に罫線を引く

    Next r
End With

'返却
katrgoriInput = gyouRow

End Function