前回までのレビュー
週間献立表で作成した作業指示書のデータを業者別発注書の作成に活用するべく、日付を名前としたCSVファイルを作成しました。
今回は第７回の仕上げとして日付のCSVファイルを具体的に業者別のシートにデータ展開して、印刷する処理を作成しました。
おさらい ①recipe2_5で料理のレシピを作成する
■レシピ作成フォームでレシピを作成するとそのレシピのレシピ番号、レシピ名などの管理情報はSheet3へ保存され、更に食材の情報はレシピ番号で紐づけされてSheet1に保存されます。
■レシピを作り終えてそのBookを閉じると、下記のようにrecipedataフォルダーに管理用と、食材詳細情報用の二つのCSVファイルに保存されます（この後の週間献立表のデータ編集時に参照します）
おさらい ②Book1週間献立表で週間献立表を作成する
■献立表の各食事区分、各曜日のセルをダブルクリックして呼び出されたレシピを選択するとそのレシピ名が転記されます。
■すべてのレシピ名がセット出来たら、「印刷とデータクリア」ボタンで献立作業指示書が作成されます。
■下図のような感じのレイアウトで各曜日ごとに作成されて印刷します。
■献立表も個別に印刷できるので献立表は食堂に貼りだしたりできます。又作業指示書は厨房に貼りだして使用します。
■この作業指示書を作成するのと同時に下図のようにhattyuuフォルダに各曜日と日付を名前にした7個のCSVファイルが作成保存されます。（この後、業者別食材発注書でこのファイルを参照します。）
■ここまでが前回第7回までのシステム作成状況でした。
③業者別発注で食材の発注書を作成します。
発注データの呼び出し
③業者別発注を開きます。オープニングシートに貼り付けた「発注データ作成」ボタンをクリックしてデータファイルを取り込み用フォームを表示します。
■リストボックスに表示した日付は、献立表から書き出された作業指示書のデータを日付ごとに名前を付けたCSVファイルの日付です。ここで献立表の作成した日付と一致するか確認して、「発注データ作成」ボタンを押します。
■程なくして業者名の各シートに曜日ごとの使用食材のリストが転記されます。
■先ほどフォームは下半分が拡張され印刷ボタンが表示されます。「印刷します」ボタンを押せば印刷して終了です。
「その他の業者」シートに付いて。
■レシピの作成時、食材を登録するとき取扱いの業者を指定する必要がありますが、うっかり空白のまま登録してしまった場合、発注書ではこの「その他の業者」シートに書き込まれます。
「パーストック」シートに付いて
■通常のその日に使用する食材を前日までに納入してもらうことをデイリー発注といい、パーストックとはその名の通り標準在庫のことで、例えば、お米の場合一週間ごとに必要な数量を在庫しておいて、一定数量になったら発注するなどでデイリー発注と分けて登録するようになっています。
本システム「recipe2_5」では食材名の先頭に（＊）アスタリスクを付けてパーストックとしています。（主にお米、調味料類などに既に＊が付いています）
■パーストックのシートでは結構多数の行数になるので食材名でソートしたうえで集計して、集計行のみを表示するよう、集計ボタンを設置しています。
■一週間でおおよそ使用する食材分量が把握できるので在庫と突き合わせて欠品しないように確認できます。
コード
■工夫したところは18行目のFor Eachステートメントで、曜日ごと一週間分のCSVコレクションから一日分ずつデータファイルを取り出して処理しています。
Private Sub CommandButton2_Click()
Dim youbiCSV As Variant
Dim data(11) As Variant
Dim r As Integer, i As Integer, c As Integer
Dim saprya As String
Dim hizuke As String
Dim youbi As String
'WeeklyCsvは日付の付いた一週間分の７個のCSVファイルが入っている
'１つのファイルには朝、昼、おやつ、夕の区分でそれぞれレシピの食材が登録されている
'下のForではWeeklyCsvから一日分だけ取り出している。例えば最初のitigyouは月曜日のデータです
'
'パーストックシートで集計中の時は解除しておく
Call kaijyo
'前回データ消去
Call zenkaikesu
For Each youbiCSV In WeeklyCsv
'日付セット
hizuke = youbiCSV(1, 1) & " " & youbiCSV(2, 1)
For r = 0 To UBound(youbiCSV, 1) - 1
If r >= 5 Then
If youbiCSV(r, 4) <> "" Then
If InStr(youbiCSV(r, 4), "水分") <= 0 Then
'業者名を調べる
saprya = youbiCSV(r, 10)
'行データを変数に格納
For i = 0 To UBound(youbiCSV, 2) - 1
data(i) = youbiCSV(r, i)
Next i
'業者名のシートにデータを転記
Call tenkai(saprya, data, hizuke)
End If
End If
End If
Next r
Next youbiCSV
'各シートごとにデータを並べ替え
Application.ScreenUpdating = False
Call narabekae
'パーストックシート集計
Call soto
Call syuukei(3)
MsgBox "転送おわったんです"
'Sheet1.Select
Application.ScreenUpdating = True
Me.CommandButton2.Visible = False
Me.Height = 315
Me.Frame1.Enabled = True
Me.Label4.Top = 114
Me.Label4.Caption = "下のボタンから印刷して下さい。。。"
Me.Label5.Top = 132
End Sub
■１８行目のFor Each youbiCSV In WeeklyCsv を解説
WeeklyCsv は二次元配列です。
For Eachでは繰り返す都度、配列から要素を一つ取り出して youbiCSV に渡します。
WeeklyCsv に取り出す要素が無くなるまで繰り返しを続けます。
WeeklyCsv とは、下図のサブプロシージャcsvDataInputで、グローバルモジュールで宣言した配列WeeklyCsvで、
一週間分の日付つきのCSVファイルのデータを二次元配列の形式で格納します。
WeeklyCsv＝｛hattyu2023_11_13月.csv , hattyu2023_11_14火.csv ,・・・・｝
という感じです。
■下図サブプロシージャcsvDataInputでは週間献立表からhattyuuフォルダーに書き出されたCSVファイル名をDIR（）関数を使って取り出して配列に取り出します。
Sub csvDataInput()
'\recipedata\hattyuu\に書き出されている発注用７個のCSVファイルを配列で返す
Dim hattyuFaile(6) As Variant
Dim fileName As String
Dim i As Integer
'配列 hattyuFaile に hattyuuフォルダーにある１個目の発注用CSVファイル名を格納する
hattyuFaile(0) = Dir(ActiveWorkbook.Path & "\recipedata\hattyuu\hattyu*.csv")
'残り６個の発注用CSVファイル名を格納する
For i = 1 To 6
hattyuFaile(i) = Dir()
Next i
'------------------------------------------------------------------------
Dim pt As Variant
Dim fail As String
Dim c As Integer
'上段の処理で取り出したCSVファイル名を使って７個分の繰り返しでSCVファイルを
c = 0
For Each pt In hattyuFaile
'ptは各曜日、日付付きCSVファイル名が入ってます
If pt = "" Then Exit For
fail = ActiveWorkbook.Path & "\recipedata\hattyuu\" & pt
WeeklyCsv(c) = det_in(fail)
c = c + 1
Next pt
End Sub
■７行目 Dir(ActiveWorkbook.Path & “\recipedata\hattyuu\hattyu*.csv”)で１個目のファイル名を格納し、１１行目Dir（）で残り６個のファイル名を取り出しています。
■２３行目で、取り出したファイル名をファンクションdet_inに渡してCSVファイルの内容データを二次元配列でを取り出してWeeklyCsvに格納しています。
■下図のFunction det_in(csvName As String)は上図の２３行目でファイル名を引数にして渡されたファンクションプロシージャです。
Function det_in(csvName As String) As Variant
'csvNameはフルパスつきｃｓｖファイル名(ファイル選択ダイアログからフルパスで来ます)
'コンボボックスのキーワードで検索した食材のリストを二次元配列に格納して返す
Dim fso As Object 'FileSystemObject
Dim ffile As Object 'File
Dim myData As Variant
Dim myDataLine As Variant
Dim Ccnt As Long, Rcnt As Long
Dim i As Long, j As Long
'csvName = ActiveWorkbook.Path & fail
'オブジェクト作成
Set fso = CreateObject("Scripting.FileSystemObject")
Set ffile = fso.OpenTextFile(csvName, 1)
' 配列の上限設定
myDataLine = Split(ffile.ReadLine, ",")
Ccnt = UBound(myDataLine) '列数
On Error Resume Next 'ファイルが一行しか無いときエラーになる
ffile.ReadAll
Rcnt = ffile.Line - 2 '行数
ffile.Close
'上で取得した列数、行数で配列要素数をセット
ReDim myData(Rcnt, Ccnt)
' ２次元配列に格納
Set ffile = fso.OpenTextFile(csvName, 1)
j = 0
Do Until ffile.AtEndOfStream
myDataLine = Split(ffile.ReadLine, ",")
For i = 0 To Ccnt
myData(j, i) = Replace(myDataLine(i), """", "")
Next
j = j + 1
Loop
ffile.Close
det_in = myData
End Function
■下図は引数のCSVファイル名で取り出した二次元配列の実態データです。
この日付ごとの配列データを、WeeklyCsv に格納しているということです
■このデータは作業指示書のデータそのものですが、このデータから発注書に必要な項目（食材名、食数当りの準備数量、納入業者名）を取り出して発注書に書き出しています。
■そして、一番最初のコードの中でこのWeeklyCsv から１個づつ配列データを取り出して業者ごとのシートに振り分けています。
こんな感じで、あっちいったり、こっち行ったりでわかりにくかったかもしれませんが、プロシージャ単位で完結した処理を積み重ねると、なんとなく処理が簡潔してしまいました。
■今回はここまでにします。
■今後の展開
給食日誌、検食簿、選択食導入、・・・・・等など考え中です。
ダウンロード
ここまでのファイルを下のカードからダウンロードできます。
コメント