栄養士さんお助けツール、文部科学省食品成分表八訂を利用する

食品成分表の準備
CSVファイルのデータを二次元配列に取り出す
1. いいね:
2. 関連

食品成分表の準備

準備概要

●前提条件

このページの内容を実行、利用するには、Microsoft　Excelがお使いのPCにインストールされている必要があります。無償で使えるウエブ版のExcelでは取り扱いできません。

●成分表八訂版を取り寄せる

文部科学省のホームページから八訂版データを取り寄せる

●CSVファイルを作成

取り寄せるファイルはExcel形式ファイルとPDF電子書籍形式の二種類ありますが、ここではExcelファイルをダウンロードしてください。
このExcelファイルをそのままでは利用しにくいのでCSVファイルにデータを変換します。
ダウンロードしたExcelファイルの１行目～１２行目までは１３行目からの成分データを説明する管理項目のセクションになっています。
この管理項目では、データを格納している各セルは見やすさのため複数のセルを結合したり書式設定したりしています。また、一つのセルの中で入力した文字列中に改行コードが入っていたりもします。更に、１３行目以降の数値データ中に数値に各種記号がプラスされていたり（）カッコで括ったりなどした部分もあります。
食品成分値は食品の１００ℊ当たりの成分を表示しているので
CSVファイルでは利用する際、数値を利用する重量当たりの値に計算しなおす必要があります。
そのため成分値に数値以外の記号などが含まれていると計算エラーを起こしてしまします。
そのため、セルに含まれる書式や結合などを解除したり記号なども取り除く必要があります。

食品成分八訂版ダウンロード

■ブラウザで文部科学省のページを検索

■赤枠をクリック

■複数のデータ項目が表示されるので上から二番目の赤枠をクリック

■Excel形式のファイルが開くので赤枠のファイルのダウンロードボタンをクリック

■一瞬でダウンロードが終了します。ダウンロードは通常PCのダウンロードフォルダーになります。

■赤枠のファイルを開くリンクをクリック

■PC版のExcelが起動してファイルが開きます。（ここではExcel2016を使っています）

■黄色の警告バーが出るので　編集を有効にする（Ｅ）ボタンをクリックします。

■　１２行目までの項目部分のセルはしっかり書式設定されています

■下図はセルの結合や改行コードを取り除いた様子です

■下図は、さらに不必要な項目を別の領域に移動したり、今後必要になると思われる列を予備として追加したりしています

そしてExcelのファイルをCSVファイルにして保存しています

■ファイル→エクスポート→ファイル種類の変更→CSV（コンマ区切り）→名前を付けて保存でCSV形式で保存します。

■ExcelでCSVを開いたところ

■メモ帳で開いた様子

データチェックと変換プログラム

■食品成分表データは横70列で約2400行ほどありセルの数は16万8千個にもなりますからこれを目視で修正するのとても大変なので下図のようなプログラムを利用します。

■下図の文字列置換用の関数を利用して計算処理の障害になるデータ中の数値以外の文字列を取り除きます。（実際一目見ただけでTr、‐、(、)、その他脚注文字などが数値データに交じっていたりします）

ここでは、Replaceは第一引数のstrに含まれる第二引数の(を取り除いて返します。

結果は一番下の”ABCDE)F” になります。

■下図では、このように取り除きたい文字列をすべて指定してとりのぞきました。

Sub spasOff()
'
' spasOff Macro
'

'
Dim max As Integer
Dim retu As Integer
Dim r As Integer
Dim c As Integer
Dim str As String

    max = Range("B2").CurrentRegion.Rows.Count
    retu = Range("B2").CurrentRegion.Columns.Count
    '１行目～１２行目までの項目エリアのセルには様々な書式が設定されています
    'これをCSVファイルに変換するときデータ取り出しますが、この書式設定が様々なエラーを引き起こします
    '例えば、セルの文字列中に改行コードやスペースが含まれているとCSVファイルではこれをカンマ区切りと判断してしまうので
    'のちのデータを使用する際データが不整合になり、正しいデータを得ることができなくなります。
    '手動でも可能ですが、下記のコードで確実にそれらを取り除きます
    
    For r = 1 To max
        For c = 1 To retu
            If Cells(r, c) <> "" Then
                str = Cells(r, c)
                '半角スペースを取り除く
                str = Replace(str, " ", "")
                
                '全角スペースを取り除く
                str = Replace(str, "　", "")
                
                '改行コードを取り除く
                str = Replace(str, vbLf, "")
                
                '元のセルに書き戻す
                Cells(r, c) = str
            End If
        Next c
    Next r
    
    'この食品成分データにはそれ以外にも様々な書式設定が使われていますが、上記以外は手動でやりました
    
End Sub

■　食品栄養成分データは、その食品の100ℊ当たりの成分を表示しています。

■　この食品成分データを利用するシステムでは例えばメニューレシピを作成するシステムの場合、そのメニューレシピを構成する各食品の成分データを使用量当たりのデータに計算で求める必要があります。

■　具体的な例として、「玉ねぎ」の成分値で蛋白質は1.0ｇですが、使用量が30gのなら

1.0ｇを100で割って30gを掛けると　0.3gと計算します。これをプログラムで使うには

■　つまり、食品栄養成分値　/　100　*　使用量　となります。

この計算で食品栄養成分値に数値と判断できない文字列等が含まれていると計算エラーが発生しプログラムがストップしてしまします。ですからあらかじめデータを整理しておく必要があるのです。

■CSVファイルのデータを整えたらいよいよこのデータを動的に利用する具体的な方法を考えていきます。

CSVファイルのデータを二次元配列に取り出す

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