[Excel VBA]鉄筋断面積などを返すユーザー定義関数

これまで、Excelのワークシート関数でごり押しして、マクロ機能を使うことが少なかったですが、計算が極端にブラックボックス化しない範囲でマクロを積極的に使って行きたいと思っています。

手始めに、鉄筋径から断面積・周長・単位質量を返すユーザー定義関数
[REBAR()]を作りました。REBAR()関数はこんな感じで動作します。

 

ソースコードを下記に示します。
鉄筋径とオプションの値でSelect Caseで分岐して、対応する値を返すというスマートさの欠片もないコードです。
※長いので閉じています。クリックで開きます

Public Function REBAR(R As Integer, Optional OPT As Integer = 0)
    'Rで鉄筋径、OPTで出力項目を指定 OPTを省略すると断面積
    Select Case OPT
        Case 0 'OPTが0の場合断面積(mm2)を返す
            Select Case R
                Case 6
                    REBAR = 31.7
                Case 10
                    REBAR = 71.3
                Case 13
                    REBAR = 126.7
                Case 16
                    REBAR = 198.6
                Case 19
                    REBAR = 286.5
                Case 22
                    REBAR = 387.1
                Case 25
                    REBAR = 506.7
                Case 29
                    REBAR = 642.4
                Case 32
                    REBAR = 794.2
                Case 35
                    REBAR = 956.6
                Case 38
                    REBAR = 1140
                Case 41
                    REBAR = 1340
                Case 51
                    REBAR = 2027
                Case Else
                    REBAR = CVErr(xlErrNum)
            End Select
        Case 1 'OPTが1の場合周長(mm)を返す
            Select Case R
                Case 6
                    REBAR = 20
                Case 10
                    REBAR = 29.9
                Case 13
                    REBAR = 39.9
                Case 16
                    REBAR = 50
                Case 19
                    REBAR = 60
                Case 22
                    REBAR = 69.8
                Case 25
                    REBAR = 79.8
                Case 29
                    REBAR = 89.9
                Case 32
                    REBAR = 99.9
                Case 35
                    REBAR = 110
                Case 38
                    REBAR = 120
                Case 41
                    REBAR = 130
                Case 51
                    REBAR = 160
                Case Else
                    REBAR = CVErr(xlErrNum)
            End Select
        Case 2 'OPTが2の場合単位重量(kg/m)を返す
            Select Case R
                Case 6
                    REBAR = 0.249
                Case 10
                    REBAR = 0.56
                Case 13
                    REBAR = 0.994
                Case 16
                    REBAR = 1.56
                Case 19
                    REBAR = 2.25
                Case 22
                    REBAR = 3.04
                Case 25
                    REBAR = 3.98
                Case 29
                    REBAR = 5.04
                Case 32
                    REBAR = 6.23
                Case 35
                    REBAR = 7.51
                Case 38
                    REBAR = 8.95
                Case 41
                    REBAR = 10.5
                Case 51
                    REBAR = 15.9
                Case Else
                    REBAR = CVErr(xlErrNum)
            End Select
        Case Else
            REBAR = CVErr(xlErrNum)
    End Select
End Function

※17/05/22 エラー処理を追加
正しく動作する事を確認します。D22の断面積の場合。

 → 

正しい値387.1mm2が返されることが確認できます。

この関数を[関数の挿入] ダイアログ ボックスに表示させるために、下記のマクロを作成し一度実行しておきます。

Sub Touroku()
'    Dim ArgDesc(1 To 2) As String
'    ArgDesc(1) = "鉄筋径"
'    ArgDesc(2) = "0:断面積(mm2) 1:周長(mm) 2:単位質量(kg/m)"    
    Application.MacroOptions Macro:="REBAR", _
        Description:="鉄筋径から断面積・周長・単位質量を返します。Rで鉄筋径を指定し、OPTで0:断面積(mm2),1:周長(mm),2:単位質量(kg/m)を指定します。"
'        ArgumentDescriptions:=ArgDesc VBAのバージョンが古いため未実装
End Sub

コメントアウトしているArgumentDescriptionsは各引数に対する説明ですが、私の利用している少し古いバージョンのExcelだと未実装で利用できませんでした。

上記を実行すると[関数の挿入] ダイアログ ボックスに反映されます。

今回のソースコードを含むExcelファイルを置いておくので、よろしければご活用ください。
REBAR.xlsm