タグ: 身体活動のメッツ表

改訂版『身体活動のメッツ表』のテキストファイル

2012年7月3日の記事で国立健康・栄養研究所に『身体活動メッツ表』から抽出したテキストファイルを公開して良いか問い合わせていましたが，7月12日回答があり，公開を許可して頂けましたので公開いたします．

下記ファイルのデータ構造は4列826行となっています．1行目はデータ構造を示しており，2行目以降がデータです．1列目はコード，2列目はMETs，3列目は大分類，4列目は個別活動となっています．日本語と英語の切り分けはできていません．

METS2011

当ファイルは国立健康・栄養研究所の改訂版『身体活動メッツ表』を元に 作成したものです．個人利用においては特に連絡の必要はございませんが，ウェブサービス等，第三者が利用するサービスに当ファイルを使用する場合には国立健康・栄養研究所に確認のご連絡をお願いします．

　2014 年 11 月 7 日，指摘を受け METS2011.csv ファイルを訂正しました．



改訂版『身体活動のメッツ表』からテキストを抽出する



　国立健康・栄養研究所が2011年版『身体活動のメッツ表』を改訂しました．下記リンクはPDFファイルですが，そのままでは使いにくいためEXCELでテキスト情報を抽出しました．2012年7月3日，国立健康・栄養研究所に抽出したテキストファイルを公開して良いか問い合わせました．

身体活動のメッツ表



1. PDFファイルを開き，全てを選択してコピーします．

2. EXCELの新規ブックを作成し，テキストファイルウィザードを使用して貼り付けます．この際，テキストファイルウィザードの2番目のタブで区切り文字の全てのチェックを外して下さい．3番目のタブでは列のデータ形式を『文字列』に変更して下さい．

3. ‘Alt’ キーと ‘F11’ キーを押下して VBE を起動し，標準モジュールを挿入して下記コードを実行して下さい．

Option Explicit
Sub METS()
Dim mySht   As Worksheet
Dim myRng   As Range
Dim myAr    As Variant
Dim i       As Long
Dim j       As Long
Dim myReg   As Object
Dim myMatches   As Object
Dim myMatch     As Object
Const strReg    As String = "^[0-9]{5}$"
Dim CODE()  As String
Dim METS()  As Single
Dim MajorHeading()  As String
Dim SpecificActivities()    As String
Dim myArray()   As Variant
Set myReg = CreateObject("VBScript.RegExp")
With myReg
    .Pattern = strReg
    .IgnoreCase = True
    .Global = True
End With

Set mySht = ActiveSheet
Set myRng = mySht.UsedRange
myAr = myRng
j = 0
For i = LBound(myAr) To UBound(myAr)
    If myReg.Test(myAr(i, 1)) Then
        Set myMatches = myReg.Execute(myAr(i, 1))
        ReDim Preserve CODE(j)
        ReDim Preserve METS(j)
        ReDim Preserve MajorHeading(j)
        ReDim Preserve SpecificActivities(j)
        CODE(j) = myAr(i, 1)
        METS(j) = myAr(i + 1, 1)
        MajorHeading(j) = myAr(i + 2, 1)
        SpecificActivities(j) = myAr(i + 3, 1)
        j = j + 1
    End If
Next i
ReDim myArray(j, 3)
For j = LBound(myArray) To UBound(myArray) - 1
    myArray(j, 0) = CODE(j)
    myArray(j, 1) = METS(j)
    myArray(j, 2) = MajorHeading(j)
    myArray(j, 3) = SpecificActivities(j)
Next j
Set mySht = Worksheets.Add
mySht.Range("A1").Value = "CODE"
mySht.Range("B1").Value = "METS"
mySht.Range("C1").Value = "MajorHeading"
mySht.Range("D1").Value = "SpecificActivities"
mySht.Range("A2:D827") = myArray
End Sub