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

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

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

 

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

[vb collapse=”true” title=”ユーザー定義関数 REBAR()”]
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
[/vb]

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

 → 

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

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

[vb firstline=”101″]
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
[/vb]

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

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

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