[Excel関数]Schofieldの式により基礎代謝量を計算するBMRSFカスタムワークシート関数

コード

下記のコードを全てコピーし、標準モジュール等に貼り付けて下さい。下記のコード表示欄の右上に「Copy」ボタンがありますのでご使用下さい。なお、標準モジュールが何だか分からない方は、 Excelのカスタムワークシート関数を使用する方法 を参照して下さい。

' [Excel関数]Schofieldの式により基礎代謝量を計算するBMRSFカスタムワークシート関数 
' Copyright (c) 2020-2024  黒箱 
' This software is released under the GPLv3. 
' このソフトウェアはGNU GPLv3の下でリリースされています。 

'* @fn Public Function BMRSF(ByVal Sex As Variant, ByVal Weight As Double, ByVal Age As Double, Optional ByVal SeeCoef As Double = 0) As Variant
'* @brief Schofield(スコフィールド)の式により、基礎代謝量(Basal metabolic rate = BMR)を算出します。
'* @param[in] Sex 性別を整数または文字列で指定します。整数の場合は、男性が1、女性が2です。文字列の場合は、文字列の先頭文字が"男","M"又は"m"の場合は男性、"女","F"又は"f"の場合は女性として処理します。
'* @param[in] Weight 体重をkgで指定します。
'* @param[in] Age 年齢を年で指定します。0以上の数値を入力してください。
'* @param[in] SeeCoef 推定値の標準誤差に乗算する係数を指定します。既定値は0です。例として、-1.96を指定すると95%信頼下限、1.96を指定すると95%信頼上限の値を得ることができます。
'* @return Variant 基礎代謝量をkcal/dayで返します。
'* @details
'* @note 計算式参照元1：https://en.wikipedia.org/wiki/Schofield_equation
'* @note 計算式参照元2：厚生労働省「日本人の食事摂取基準(2020年版)」p72 表4
'*
Public Function BMRSF(ByVal Sex As Variant, ByVal Weight As Double, ByVal Age As Double, Optional ByVal SeeCoef As Double = 0) As Variant
Const UNKNOWN_GENDER = 0
Const MALE As Long = 1 '男性
Const FEMALE As Long = 2 '女性
    
    '男女の判別
    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
        BMRSF = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End If
    
    '年齢がマイナスの場合は計算不可
    If (Age < 0) Then
        BMRSF = CVErr(2036) 'CVErr(2036) '#NUM!
        Exit Function
    End If
    
    
    'BMR計算
    Dim Result As Variant
    If (SexNo = MALE) Then
        Select Case (Int(Age))
        Case 0 To 2:    Result = ((249 * Weight - 127) + (292 * SeeCoef))
        Case 3 To 9:    Result = ((95 * Weight + 2110) + (280 * SeeCoef))
        Case 10 To 17:  Result = ((74 * Weight + 2754) + (441 * SeeCoef))
        Case 18 To 29:  Result = ((63 * Weight + 2896) + (641 * SeeCoef))
        Case 30 To 59:  Result = ((48 * Weight + 3653) + (700 * SeeCoef))
        Case Else:      Result = ((49 * Weight + 2459) + (686 * SeeCoef)) '60歳以上
        End Select
    
    Else
        Select Case (Int(Age))
        Case 0 To 2:    Result = ((244 * Weight - 130) + (246 * SeeCoef))
        Case 3 To 9:    Result = ((85 * Weight + 2033) + (292 * SeeCoef))
        Case 10 To 17:  Result = ((56 * Weight + 2898) + (466 * SeeCoef))
        Case 18 To 29:  Result = ((62 * Weight + 2036) + (497 * SeeCoef))
        Case 30 To 59:  Result = ((34 * Weight + 3538) + (465 * SeeCoef))
        Case Else:      Result = ((38 * Weight + 2755) + (451 * SeeCoef)) '60歳以上
        End Select
    
    End If

    BMRSF = Result / 4.186 'Joule to cal
End Function