[Excel関数]基礎代謝基準値により基礎代謝量を計算するBMRDRIカスタムワークシート関数

2020年12月6日

概要

BMRDRIカスタムワークシート関数は、「日本人の食事摂取基準」の基礎代謝基準値により、1日の基礎代謝量(Basal metabolic rate = BMR)を計算します。他の計算方法で基礎代謝量を計算した場合は、下記のページを参照して下さい。

動作例

機能

性別、体重(kg)及び年齢より、1日の基礎代謝量(kcal/日)を算出します。計算方法は厚生労働省「日本人の食事摂取基準」の基礎代謝基準値に基づいており、使用する基礎代謝基準値は2010年版、2015年版及び2020年版に対応しております。

計算式

\( \large{ 基礎代謝量(kcal/day) = BMS \cdot W} \)

\( BMS:基礎代謝基準値(kcal/kg/day)(表1~2参照) \)
\( W:体重(kg) \)

表1.2020年版の基礎代謝基準値(kcal/kg/day)

年齢(歳)男性女性
1~26159.7
3~554.852.2
6~744.341.9
8~940.838.3
10~1137.434.8
12~143129.6
15~172725.3
18~2923.722.1
30~4922.521.9
50~6421.820.7
65~7421.620.7
75以上21.520.7

表2.2010年版及び2015年版の基礎代謝基準値(kcal/kg/day)

年齢(齢)男性女性
1~261.059.7
3~554.852.2
6~744.341.9
8~940.838.3
10~1137.434.8
12~1431.029.6
15~1727.025.3
18~2924.022.1
30~4922.321.7
50~6921.520.7
70以上21.520.7

構文

BMRDRI(性別, 体重, 年齢, 版番号 )

引数説明引数の指定既定値
性別性別を整数または文字列で指定します。整数の場合は、男性が1、女性が2です。
文字列の場合は、文字列の先頭文字が"男","M"又は"m"の場合は男性、"女","F"又は"f"の場合は女性として処理します。
必須(無し)
体重体重をkgで指定します。必須(無し)
年齢年齢を年で指定します。1以上の数値を入力して下さい。必須(無し)
版番号「日本人の食事摂取基準」の版番号を指定します。指定可能な値は、2010、2015及び2020です。
0を指定すると、最新のバージョンが指定されます。既定値は0です。
省略可能0

コード

下記のコードを全てコピーし、標準モジュール等に貼り付けて下さい。下記のコード表示欄の右上に「Copy」ボタンがありますのでご使用下さい。なお、標準モジュールが何だか分からない方は、 Excelのカスタムワークシート関数を使用する方法 を参照して下さい。
' [Excel関数]基礎代謝基準値により基礎代謝量を計算するBMRDRIカスタムワークシート関数 
' Copyright (c) 2020-2024  黒箱 
' This software is released under the GPLv3. 
' このソフトウェアはGNU GPLv3の下でリリースされています。 

'* @fn Public Function BMRDRI(ByVal Sex As Variant, ByVal Weight As Double, ByVal Age As Double, Optional ByVal DriVersion As Long = 0) As Variant
'* @brief 厚生労働省「日本人の食事摂取基準」の基礎代謝基準値により、基礎代謝量(Basal metabolic rate = BMR)を算出します。
'* @param[in] Sex 性別を整数または文字列で指定します。整数の場合は、男性が1、女性が2です。文字列の場合は、文字列の先頭文字が"男","M"又は"m"の場合は男性、"女","F"又は"f"の場合は女性として処理します。
'* @param[in] Weight 体重をkgで指定します。
'* @param[in] Age 年齢を年で指定します。1以上の数値を入力して下さい。
'* @param[in] DriVersion 「日本人の食事摂取基準」の版番号を指定します。指定可能な値は、2010、2015及び2020です。0を指定すると、最新のバージョンが指定されます。既定値は0です。
'* @return Variant 基礎代謝量をkcal/dayで返します。
'* @details
'* @note 各版の基礎代謝基準値は下記を参照した。
'* @note 日本人の食事摂取基準(2020年版)  p74 表5参照
'* @note 日本人の食事摂取基準(2015年版)  p66 表6参照
'* @note 日本人の食事摂取基準(2010年版)  p45 表1参照
'*
Public Function BMRDRI(ByVal Sex As Variant, ByVal Weight As Double, ByVal Age As Double, Optional ByVal DriVersion As Long = 0) As Variant
Const UNKNOWN_GENDER = 0
Const MALE As Long = 1 '男性
Const FEMALE As Long = 2 '女性
    
Const LatestDriVer As Long = 2020 '食事摂取基準の最新版(本関数のバージョンアップ時にこの値は変更される可能性があります)
    
    'Ageが0歳以下の場合はエラー
    Dim IntAge As Long
    IntAge = Int(Age)
    If (IntAge <= 0) Then
        BMRDRI = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End If
    
    '男女の判別
    Dim SexNo As Long
    If (VarType(Sex) = vbString) Then
        
        Select Case (Left(UCase(Sex), 1))
        Case "男", "M": SexNo = MALE
        Case "女", "F": SexNo = FEMALE
        Case Else:  SexNo = UNKNOWN_GENDER
        End Select
    
    Else
        SexNo = CLng(Sex)
        If ((SexNo <> MALE) And (SexNo <> FEMALE)) Then SexNo = UNKNOWN_GENDER
    
    End If
        
    If (SexNo = UNKNOWN_GENDER) Then
        BMRDRI = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End If
    

    'BMR計算
    If (DriVersion = 0) Then DriVersion = LatestDriVer
    
    '年齢が1未満の場合は計算不可
    If (Age < 1) Then
        BMRDRI = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End If
    
    Dim bms As Double
    
    Select Case (DriVersion)
    Case 2010: bms = GetBMS2010(SexNo, IntAge)
    Case 2015: bms = GetBMS2015(SexNo, IntAge)
    Case 2020: bms = GetBMS2020(SexNo, IntAge)
    Case Else
        BMRDRI = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End Select

    BMRDRI = bms * Weight

End Function


'* @fn Private Function GetBMS2020(ByVal SexNo As Long, ByVal Age As Long) As Double
'* @brief 厚生労働省「日本人の食事摂取基準(2020年版)」の基礎代謝基準値を取得します。
'* @param[in] Sex 性別を整数で指定します。男性が1、女性が2です。
'* @param[in] Age 年齢を年で指定します。1以上の数値を入力して下さい。1未満の数値を入力すると0を返します。
'* @return Double 基礎代謝基準値を返します。
'* @note 日本人の食事摂取基準(2020年版)  p74 表5参照
'*
Private Function GetBMS2020(ByVal SexNo As Long, ByVal Age As Long) As Double
Const UNKNOWN_GENDER = 0
Const MALE As Long = 1 '男性
Const FEMALE As Long = 2 '女性
    
    Dim bms As Double 'bms = basal metabolism standard
    If (SexNo = MALE) Then
        If (Age < 15) Then
            Select Case (Age)
            Case 1 To 2:    bms = 61
            Case 3 To 5:    bms = 54.8
            Case 6 To 7:    bms = 44.3
            Case 8 To 9:    bms = 40.8
            Case 10 To 11:  bms = 37.4
            Case Else:      bms = 31 '12~14歳
            End Select
            
        Else
            Select Case (Age)
            Case 15 To 17:  bms = 27
            Case 18 To 29:  bms = 23.7
            Case 30 To 49:  bms = 22.5
            Case 50 To 64:  bms = 21.8
            Case 65 To 74:  bms = 21.6
            Case Else:      bms = 21.5 '75歳以上
            End Select
        End If
        
        
    Else
        If (Age < 15) Then
            Select Case (Age)
            Case 1 To 2:    bms = 59.7
            Case 3 To 5:    bms = 52.2
            Case 6 To 7:    bms = 41.9
            Case 8 To 9:    bms = 38.3
            Case 10 To 11:  bms = 34.8
            Case Else:      bms = 29.6 '12~14歳
            End Select
            
        Else
            Select Case (Age)
            Case 15 To 17:  bms = 25.3
            Case 18 To 29:  bms = 22.1
            Case 30 To 49:  bms = 21.9
            Case 50 To 64:  bms = 20.7
            Case 65 To 74:  bms = 20.7
            Case Else:      bms = 20.7 '75歳以上
            End Select
        End If
    End If
    
    GetBMS2020 = bms

End Function

'* @fn Private Function GetBMS2020(ByVal SexNo As Long, ByVal Age As Long) As Double
'* @brief 厚生労働省「日本人の食事摂取基準(2015年版)」の基礎代謝基準値を取得します。
'* @param[in] Sex 性別を整数で指定します。男性が1、女性が2です。
'* @param[in] Age 年齢を年で指定します。1以上の数値を入力して下さい。1未満の数値を入力すると0を返します。
'* @return Double 基礎代謝基準値を返します。
'* @note 日本人の食事摂取基準(2015年版)  p66 表6参照
'* @note 2015年版は2010年版から変更が無いため、内部でGetBMS2010を呼び出します。
'*
Private Function GetBMS2015(ByVal SexNo As Long, ByVal Age As Long) As Double
    GetBMS2015 = GetBMS2010(SexNo, Age)
End Function

'* @fn Private Function GetBMS2020(ByVal SexNo As Long, ByVal Age As Long) As Double
'* @brief 厚生労働省「日本人の食事摂取基準(2010年版)」の基礎代謝基準値を取得します。
'* @param[in] Sex 性別を整数で指定します。男性が1、女性が2です。
'* @param[in] Age 年齢を年で指定します。1以上の数値を入力して下さい。1未満の数値を入力すると0を返します。
'* @return Double 基礎代謝基準値を返します。
'* @note 日本人の食事摂取基準(2010年版)  p45 表1参照
'*
Private Function GetBMS2010(ByVal SexNo As Long, ByVal Age As Long) As Double
Const UNKNOWN_GENDER = 0
Const MALE As Long = 1 '男性
Const FEMALE As Long = 2 '女性
    
    Dim bms As Double 'bms = basal metabolism standard
    If (SexNo = MALE) Then
        If (Age < 15) Then
            Select Case (Age)
            Case 1 To 2:    bms = 61
            Case 3 To 5:    bms = 54.8
            Case 6 To 7:    bms = 44.3
            Case 8 To 9:    bms = 40.8
            Case 10 To 11:  bms = 37.4
            Case Else:      bms = 31 '12~14歳
            End Select
            
        Else
            Select Case (Age)
            Case 15 To 17:  bms = 27
            Case 18 To 29:  bms = 24
            Case 30 To 49:  bms = 22.3
            Case 50 To 69:  bms = 21.5
            Case Else:      bms = 21.5 '70歳以上
            End Select
        End If
        
        
    Else
        If (Age < 15) Then
            Select Case (Age)
            Case 1 To 2:    bms = 59.7
            Case 3 To 5:    bms = 52.2
            Case 6 To 7:    bms = 41.9
            Case 8 To 9:    bms = 38.3
            Case 10 To 11:  bms = 34.8
            Case Else:      bms = 29.6 '12~14歳
            End Select
            
        Else
            Select Case (Age)
            Case 15 To 17:  bms = 25.3
            Case 18 To 29:  bms = 22.1
            Case 30 To 49:  bms = 21.7
            Case 50 To 69:  bms = 20.7
            Case Else:      bms = 20.7 '70歳以上
            End Select
        End If
    End If
    
    GetBMS2010 = bms

End Function

プログラムの利用について

本プログラムのライセンスは「GPL-3.0(GNU General Public License version 3)」を適用しています。

本プログラムを私的に利用(個人利用、並びに企業またはその他の組織の内部利用)される方は、本プログラムを無償で利用できると考えて差し支え御座いません。その場合でも、本プログラム内の著作権及びライセンスの表示は削除せずに表示しておいて下さい。

その他の方は、GNU 一般公衆利用許諾書(GNU GENERAL PUBLIC LICENSE)バージョン3の内容をご理解頂き、適正な利用をお願い致します。同ライセンス以外での利用をご希望の方はお問い合わせフォームよりご連絡下さい。

本ホームページのプログラムを書籍またはホームページ等で一般公開したい方は、お問い合わせフォームよりご連絡下さい。

スポンサーリンク