『スマート栄養計算』をVBAを利用してもっと便利にしよう！

2019.08.07

みなさん，こんにちは。
シンノユウキ（shinno1993）です。

前回は，栄養計算アドインである『スマート栄養計算』の応用的な使い方について紹介しました。

『スマート栄養計算』の使い方を理解しよう！（応用編）
スマート栄養計算についての連載の第３回。今回はスマート栄養計算の応用的な使い方：食事区分・献立ごとの合計の算出方法，エネルギー産生栄養素比率，ユーザー食品・ユーザー料理の機能を紹介します。
www.y-shinno.com
2019.08.02

今回は，更に応用的な内容として，Excelのマクロを構成しているプログラミング言語：VBAを活用して，もっと便利に使える方法を紹介したいと思います。

VBAがある程度は使える方を前提としていますので，それに関する基本的な解説は省略します。

スマート栄養計算
  1. 概要・良いところ・悪いところを理解する
  2. 使い方を理解する（基本編） ← 今回紹介
  3. 使い方を理解する（応用編）
  4. VBAを利用してもっと便利に（上級編）← 今回紹介
日本食品成分表2022 八訂 栄養計算ソフト・電子版付
日本食品成分表2022 八訂 栄養計算ソフト・電子版付
医歯薬出版
Amazonの商品レビュー・口コミを見る
Amazon
楽天

PFCバランスを円グラフで表示する

PFCバランス自体は，スマート栄養計算の標準機能でも表示させることができます。しかし，ダイアログで表示させるだけなので，扱いやすいとは言い難いかと思います。

そこで，PCFバランスを円グラフで表示させるマクロを作成してみました。

Sub createPFC()
    '合計行を取得
    Dim row_sum As Long
    row_sum = Application.WorksheetFunction.Match("総　合　計", ActiveSheet.Columns(5), 0)
    
    'エネルギー，たんぱく質，脂質の列を取得
    Const ROW_HEADER As Long = 2 '2行目に栄養素項目は表示される
    Dim col_energy As Long, col_protein As Long, col_fat As Long
    col_energy = Application.WorksheetFunction.Match("エネルギー" & vbLf & "(kcal)", ActiveSheet.Rows(ROW_HEADER), 0)
    col_protein = Application.WorksheetFunction.Match("たんぱく質" & vbLf & "(g)", ActiveSheet.Rows(ROW_HEADER), 0)
    col_fat = Application.WorksheetFunction.Match("脂質" & vbLf & "(g)", ActiveSheet.Rows(ROW_HEADER), 0)
    
    'エネルギー，たんぱく質，脂質の値を取得
    Dim energy As Double, protein As Double, fat As Double
    energy = ActiveSheet.Cells(row_sum, col_energy).Value
    protein = ActiveSheet.Cells(row_sum, col_protein).Value
    fat = ActiveSheet.Cells(row_sum, col_fat).Value
    
    'PFC比率を算出
    Dim protein_ratio As Double, fat_ratio As Double, carbon_ratio As Double
    protein_ratio = (protein * 4 / energy) * 100
    fat_ratio = (fat * 9 / energy) * 100
    carbon_ratio = 100 - protein_ratio - fat_ratio
    
    'シートに値を表示
    With ActiveSheet.Cells(row_sum, 5)
        .Offset(2, 0).Value = "たんぱく質"
        .Offset(2, 1).Value = protein_ratio
        .Offset(3, 0).Value = "脂質"
        .Offset(3, 1).Value = fat_ratio
        .Offset(4, 0).Value = "炭水化物"
        .Offset(4, 1).Value = carbon_ratio
    End With

    'グラフの作成
    With ActiveSheet.Shapes.AddChart.Chart
        .ChartType = xlPie
        .SetSourceData ActiveSheet.Cells(row_sum, 5).Offset(2, 0).CurrentRegion
        .HasTitle = True
        .ChartTitle.Text = "PFC比率"
    End With
End Sub

実行すると，以下のようにシートにPFC比率の値とグラフが表示されます。Excel標準のグラフですので，編集なども思いのままです：

事前準備として，PFC比率を表示するシートでは，エネルギー・たんぱく質・脂質は必ず表示し，計算を行っておいてください。

合計行を集計する

献立を複数日作成し，その合計を集計したいなーという時，あるかと思います。たとえば，などですね。その際に使えるマクロを作成しました。

以下のように，「１日目」，「２日目」，「３日目」というシートがあったとします（シート名は何でもいいです）。この３つの献立の合計を集計します。

コードは以下になります：

Sub 合計行を集計する()
    '集計シートを作成
    Dim ws_summary As Worksheet
    Set ws_summary = Worksheets.Add(after:=Worksheets(Worksheets.count))
    ws_summary.Name = "合計行の集計" & Format(Now, "yymmddhhmmss")
    
    'それぞれのシートから合計を集める
    Dim ws As Worksheet
    Dim count As Long: count = 3 '３行目以降に転記。２行目まではタイトル行
    For Each ws In ThisWorkbook.Worksheets
        On Error Resume Next
        Dim ret As Variant: ret = Nothing
        ret = Application.WorksheetFunction.Match("総　合　計", ws.Columns(5), 0)
        If ret > 0 And Left(ws.Name, 6) <> "合計行の集計" Then '"総合計"がシートに含まれる→retが０より大きくなる
            '初回のみタイトル行を取得
            If count = 3 Then
                ws.Rows("1:2").Copy ws_summary.Rows("1:2")
            End If
            '集計シートに転記。１列目はシート名に
            ws.Rows(ret).Copy ws_summary.Rows(count)
            ws_summary.Cells(count, 1).Value = ws.Name
            count = count + 1
        End If
    Next
End Sub

合計を集計する際，１列目にはシート名を入れています。わかりやすいシート名をつけておくと，集計した際にわかりやすいですね。

食品群ごとに合計する

最後に，献立を食品群ごとに合計するマクロを紹介します。食品構成表や，加重平均成分表などを作成したい際に重宝すると思います。

コードは以下になります：

Sub 食品群ごとに集計する()
    '食品群の列を取得
    Dim ws_org As Worksheet
    Set ws_org = ActiveSheet
    Dim col_foodgroup As Long
    col_foodgroup = Application.WorksheetFunction.Match("食品群", ActiveSheet.Rows(2), 0)

    '集計シートを作成
    Dim ws_summary As Worksheet
    Set ws_summary = Worksheets.Add(after:=Worksheets(Worksheets.count))
    ws_summary.Name = "食品群別の集計" & Format(Now, "yymmddhhmmss")
    ws_org.Rows("1:2").Copy ws_summary.Rows("1:2") 'タイトル行
    
    '食品群の配列を設定
    Dim ary_foodgroup As Variant
    ary_foodgroup = Array( _
        "01_穀類", "02_いも及びでん粉類", "03_砂糖及び甘味類", "04_豆類", "05_種実類", "06_野菜類", _
        "07_果実類", "08_きのこ類", "09_藻類", "10_魚介類", "11_肉類", "12_卵類", _
        "13_乳類", "14_油脂類", "15_菓子類", "16_し好飲料類", "17_調味料及び香辛料類", "18_調理済み流通食品類" _
    )
    
    '食品群ごとに合計していく
    Dim i As Long, j As Long
    Const START_ROW As Long = 3
    Const COL_WEIGHT As Long = 6
    For i = 0 To 17
        ws_summary.Cells(i + START_ROW, col_foodgroup).Value = ary_foodgroup(i)
        '重量の集計
        ws_summary.Cells(i + START_ROW, COL_WEIGHT).Value = Application.WorksheetFunction.SumIf( _
            ws_org.Columns(col_foodgroup), _
            ary_foodgroup(i), _
            ws_org.Columns(COL_WEIGHT) _
        )
        '食品群以降の栄養素の集計
        j = col_foodgroup + 1
        Do Until ws_summary.Cells(2, j).Value = ""
            If ws_summary.Cells(2, j).Value <> "廃棄率" & vbLf & "(％)" Then '廃棄率は計算しない
                ws_summary.Cells(i + START_ROW, j).Value = Application.WorksheetFunction.SumIf( _
                    ws_org.Columns(col_foodgroup), _
                    ary_foodgroup(i), _
                    ws_org.Columns(j) _
                )
            End If
            j = j + 1
        Loop
    Next i
End Sub

上記を実行すると、アクティブなシートで食品群ごとに合計してくれます重量が食品群名の左側にあるのでやや分かりづらいのが残念ですが，これで一応の役割は果たせるかと思います。

まとめ

今回は，VBAを活用した便利な使い方を紹介しました。VBAを活用して自分の思う通りに集計などができるのは，Excelアドイン独自の強みだと思います。今回紹介したもの以外にもたくさんあるかと思いますので，ぜひ活用してみてください。

連載目次

  1. 『スマート栄養計算』の概要を理解しよう！良いところ・悪いところも紹介
  2. 『スマート栄養計算』の使い方を理解しよう！（基本編）
  3. 『スマート栄養計算』の使い方を理解しよう！（応用編）
  4. 『スマート栄養計算』をVBAを利用してもっと便利にしよう！現在のページ
タイトルとURLをコピーしました