【無料：Excelマクロ】障害支援区分シミュレーションツール！（厚労省マニュアル準拠）

Excel

はじめに

さて今回は、障害支援区分のシミュレーションツールを作ったので展開します。

別の記事でWEBアプリを作ったのですが、IT知識の無い人にとっては少々難しいのかと感じましたので、もっと簡単に利用できるようExcelのマクロに落とし込みました。

マクロが何か分かっていない人もいるかもしれませんが、とりあえず気にせずExcelでできるということだけ理解してもらえればと思います。

できること・前提・注意事項

できることや前提、注意事項などは前回まとめた記事を見てください。

ざっくりまとめると、

  • 厚労省が出しているマニュアル準拠
  • あくまでも正式なシミュレーションではなく、一次判定の参考程度

的な感じです。細かいところは記事をご覧ください。

Excelマクロ

それでは早速Excelマクロを作っていきましょう。

まずは質問項目や、マクロ（プログラムコード）の準備が必要なので、以下手順に従ってください。

作成するのは以下画像のようなExcelです。完全には真似しなくてOKなので、ポイントだけ抑えておきましょう。

1. 質問No.、質問、回答欄の準備

まずは質問No.、質問、回答欄を準備しましょう。

  • A列：質問No.
  • B列：質問
  • C列：回答

とします。回答は作りこむならリスト形式で選べるようにしておけると、想定していない回答は選べなくなるので良いですね。ただ作りこまなくてよいのであれば、とりあえず枠だけ用意しておくので大丈夫です。

D列：メモ欄は何かしら回答を選択した根拠を記載しておくのに便利だと思ったので個人的に付け足しただけです。この辺りはどうぞご自由に。

質問内容は厚労省のマニュアルを参考に。

障害支援区分
障害支援区分について紹介しています。
www.mhlw.go.jp

2. シミュレーション出力結果欄の準備

次に、シミュレーションの出力結果欄を準備しましょう。

E列、F列に非該当~区分6まで用意します。ラベルは以下のようにE列に用意してください。F列に結果が出力されます。

  • E2：非該当
  • E3：区分1
  • E4：区分2
  • E5：区分3
  • E6：区分4
  • E7：区分5
  • E8：区分6

としてください。

3. マクロの準備

一番のメイン、マクロを準備します。

3-1. 開発タブを表示

まずはマクロを使うための開発タブを表示させます。既に表示されている人は無視でOKです。表示されていない方は以下手順を行ってください。

  1. ファイルタブを押下
  2. 左下オプションを押下
  3. リボンのユーザー設定を押下
  4. 開発にチェック
  5. OKを押下

これで開発タブが表示されるはずです。

3-2. Visual Basicを押下

開発タブのVisual Basicを押下しましょう。マクロ（プログラムコード）をかける画面が立ち上がります。

3-3. マクロ（プログラムコード）を記載

ようやくです、マクロ（プログラムコード）を記載しましょう。

挿入タブの標準モジュールを押下すると、マクロ（プログラムコード）を記載するための画面が立ち上がるので押下してください。真っ白な何も書かれていない画面が立ち上がると思います。

そこに、以下コードをコピペしましょう。

Option Explicit

Dim dictAns As Object

' メイン処理：ボタンに登録するマクロ
Sub RunSimulation()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' 結果出力エリア(F2:F8)のクリア
    ws.Range("F2:F8").ClearContents
    
    ' 1. A列?C列の回答データをメモリに読み込む
    Set dictAns = CreateObject("Scripting.Dictionary")
    Dim r As Range
    For Each r In ws.Range("A2:A150")
        If r.Value <> "" And IsNumeric(r.Offset(0, 2).Value) Then
            dictAns(CStr(r.Value)) = CInt(r.Offset(0, 2).Value)
        End If
    Next r

    ' 2. 各分野のスコアを計算
    Dim kikyo As Double, seikatsu1 As Double, seikatsu2 As Double
    Dim ouyou As Double, ninchi As Double, shichoukaku As Double
    Dim koudouA As Double, koudouB As Double, koudouC As Double
    Dim iryou As Double, mahi_koushuku As Double
    
    kikyo = ScoreA(A("1-1")) + ScoreA(A("1-2")) + ScoreA(A("1-3")) + ScoreA(A("1-4")) + ScoreA(A("1-5")) + ScoreA(A("1-6")) + ScoreA(A("1-7"))
    seikatsu1 = ScoreA(A("1-8")) + ScoreA(A("1-9")) + Score3(A("1-12")) + Score3(A("2-1")) + Score3(A("2-3")) + Score3(A("2-4")) + Score3(A("2-5"))
    seikatsu2 = ScoreA(A("1-10")) + Score2(A("1-11")) + Score3(A("2-2")) + Score3(A("2-6"))
    ouyou = Score3(A("2-7")) + Score3(A("2-8")) + Score3(A("2-9")) + Score3(A("2-12")) + Score3(A("2-13")) + Score3(A("2-14")) + Score3(A("2-15")) + Score3(A("2-16"))
    ninchi = Score3(A("2-10")) + Score3(A("2-11")) + Score5(A("3-3")) + Score3(A("3-4")) + Score3(A("3-5")) + Score2(A("3-6"))
    shichoukaku = Score6(A("3-1")) + Score6(A("3-2"))
    
    koudouA = Score5(A("4-1")) + Score5(A("4-2")) + Score5(A("4-3")) + Score5(A("4-4")) + Score5(A("4-5")) + Score5(A("4-6")) + Score5(A("4-7")) + Score5(A("4-8")) + Score5(A("4-21")) + Score5(A("4-22")) + Score5(A("4-26"))
    koudouB = Score5(A("4-9")) + Score5(A("4-10")) + Score5(A("4-11")) + Score5(A("4-12")) + Score5(A("4-18")) + Score5(A("4-19")) + Score5(A("4-20")) + Score5(A("4-24")) + Score5(A("4-27")) + Score5(A("4-28")) + Score5(A("4-33"))
    koudouC = Score5(A("4-13")) + Score5(A("4-14")) + Score5(A("4-15")) + Score5(A("4-16")) + Score5(A("4-17")) + Score5(A("4-23")) + Score5(A("4-25")) + Score5(A("4-29")) + Score5(A("4-30")) + Score5(A("4-31")) + Score5(A("4-32")) + Score5(A("4-34"))
    
    iryou = Score2(A("5-1")) + Score2(A("5-2")) + Score2(A("5-3")) + Score2(A("5-4")) + Score2(A("5-5")) + Score2(A("5-6")) + Score2(A("5-7")) + Score2(A("5-8")) + Score2(A("5-9")) + Score2(A("5-10")) + Score2(A("5-11")) + Score2(A("5-12"))
    mahi_koushuku = ScoreA(A("1-1")) + ScoreA(A("1-2")) + ScoreA(A("1-3")) + ScoreA(A("1-4"))

    ' 3. 特殊インデックスの判定
    Dim mahi As Integer: mahi = 1
    If A("1-1") = 2 And A("1-2") = 2 And A("1-3") = 2 And A("1-4") = 2 Then mahi = 5
    If A("1-3") = 2 And A("1-4") = 2 Then mahi = 3
    If A("1-1") = 2 Or A("1-2") = 2 Or A("1-3") = 2 Or A("1-4") = 2 Then mahi = 2

    Dim mahi_migi_ashi As Integer: mahi_migi_ashi = A("1-4")
    Dim mahi_hidari_ashi As Integer: mahi_hidari_ashi = A("1-3")
    Dim mahi_migi_te As Integer: mahi_migi_te = A("1-2")
    Dim mahi_hidari_te As Integer: mahi_hidari_te = A("1-1")
    Dim koushuku_kata As Integer: koushuku_kata = 1
    Dim koushuku_komata As Integer: koushuku_komata = 1
    Dim koushuku_hiji As Integer: koushuku_hiji = 1
    Dim koushuku_hiza As Integer: koushuku_hiza = 1
    Dim koushuku_sonota As Integer: koushuku_sonota = 1
    
    Dim nijiku_nouryoku As Integer: nijiku_nouryoku = A("2-10")
    Dim shougai_shokuji As Integer: shougai_shokuji = A("2-1")
    Dim shougai_kinsen As Integer: shougai_kinsen = A("2-8")
    Dim shougai_taijin As Integer: shougai_taijin = A("4-28")
    Dim shougai_rhythm As Integer: shougai_rhythm = A("4-4")
    Dim shougai_fukuyaku As Integer: shougai_fukuyaku = A("2-7")
    Dim shougai_hoji As Integer: shougai_hoji = A("1-3")
    Dim hankouteki As Integer: hankouteki = A("4-8")

    ' 4. 分岐ルール（決定木）の評価：全80パターン
    Dim p As Variant
    Dim matched As Boolean
    matched = True

    If seikatsu2 <= 23.5 And ouyou = 0# And koudouA = 0# And koudouC = 0# And A("2-8") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(62.2, 25.7, 10.8, 1.3, 0#, 0#, 0#)
    ElseIf ouyou = 0# And koudouA = 0# And koudouB = 0# And iryou = 0# And A("1-7") = 1 And A("4-31") = 1 And koushuku_kata = 1 And shougai_shokuji = 1 Then
        p = Array(82.4, 11.8, 0#, 5.8, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB = 0# And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(4.2, 64#, 28.4, 2.8, 0.6, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 13# And koudouA = 0# And (A("2-8") = 2 Or A("2-8") = 3) And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku >= 2 And nijiku_nouryoku <= 5) Then
        p = Array(12.5, 80.4, 3.6, 3.5, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB >= 0.1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku = 1 Or nijiku_nouryoku = 2) Then
        p = Array(0#, 66.1, 31.4, 2.5, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 13# And koudouA = 0# And (A("2-8") = 2 Or A("2-8") = 3) And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku = 1 Or nijiku_nouryoku = 2 Or nijiku_nouryoku = 3) Then
        p = Array(17.5, 61.3, 20#, 1.2, 0#, 0#, 0#)
    ElseIf seikatsu2 >= 23.5 And ouyou <= 13# And koudouA = 0# And koudouC >= 0.1 And A("2-8") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(18.5, 61.1, 18.5, 1.9, 0#, 0#, 0#)
    ElseIf kikyo >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(0.8, 50.9, 40.4, 7#, 0.9, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu1 <= 15.5 And seikatsu2 = 0# And ouyou >= 36.2 And ouyou <= 73.2 And koudouA >= 20.1 And koudouC <= 12.4 And A("4-3") = 1 Then
        p = Array(0#, 62.6, 31.3, 6.1, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 >= 23.5 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC >= 23.7 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(0#, 50#, 45.3, 4.7, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB >= 0.1 And A("4-3") = 1 And A("4-29") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku = 3 Or nijiku_nouryoku = 4 Or nijiku_nouryoku = 5) Then
        p = Array(0#, 47.4, 44#, 6.9, 1.7, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou >= 0.1 And ouyou <= 13# And koudouA = 0# And koudouC = 0# And A("2-8") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(37.2, 42.1, 19.8, 0.9, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 <= 23.5 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC <= 23.6 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (shougai_kinsen = 4 Or shougai_kinsen = 5) Then
        p = Array(0#, 64#, 33.3, 2.7, 0#, 0#, 0#)
    ElseIf seikatsu1 >= 0.1 And seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi <= 10.7 And koudouA >= 0.1 And koudouA <= 14.1 And koudouC <= 14# And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(3.1, 59.1, 24.2, 13.6, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 <= 23.5 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC <= 23.6 And (A("2-10") = 2 Or A("2-10") = 3) And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (shougai_kinsen = 1 Or shougai_kinsen = 2 Or shougai_kinsen = 3) Then
        p = Array(1.2, 92.7, 6.1, 0#, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 <= 6.7 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC <= 23.6 And A("2-10") = 1 And (A("2-15") = 2 Or A("2-15") = 3) And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (shougai_kinsen = 1 Or shougai_kinsen = 2 Or shougai_kinsen = 3) Then
        p = Array(0#, 88.9, 11.1, 0#, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 <= 6.7 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC <= 23.6 And A("2-10") = 1 And A("2-15") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (shougai_kinsen = 1 Or shougai_kinsen = 2 Or shougai_kinsen = 3) Then
        p = Array(6.9, 74.1, 17.2, 1.8, 0#, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu2 >= 6.8 And seikatsu2 <= 23.5 And ouyou >= 13.1 And ouyou <= 36.1 And koudouA = 0# And koudouC <= 23.6 And A("2-10") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) And (shougai_kinsen = 1 Or shougai_kinsen = 2 Or shougai_kinsen = 3) Then
        p = Array(0#, 72.3, 26.2, 1.5, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And koudouA = 0# And iryou = 0# And A("2-2") = 2 And shougai_kinsen = 3 Then
        p = Array(0#, 88.9, 11.1, 0#, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And koudouA = 0# And A("2-8") = 2 And nijiku_nouryoku = 2 And shougai_taijin = 2 Then
        p = Array(3.4, 96.6, 0#, 0#, 0#, 0#, 0#)
    ElseIf A("2-3") = 1 And A("4-3") = 1 And nijiku_nouryoku = 2 And shougai_rhythm = 1 And shougai_fukuyaku = 2 Then
        p = Array(0#, 84.4, 12.5, 3.1, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And A("2-12") = 2 And A("4-3") = 1 And nijiku_nouryoku = 2 And shougai_rhythm = 1 Then
        p = Array(0#, 82.9, 17.1, 0#, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ninchi >= 0.1 And ninchi <= 13.1 And koudouA = 0# And A("2-8") = 2 And nijiku_nouryoku = 2 Then
        p = Array(0#, 87#, 10.9, 2.1, 0#, 0#, 0#)
    ElseIf ouyou >= 0.1 And ouyou <= 32.9 And koudouA = 0# And A("2-14") = 2 And shougai_shokuji = 3 And shougai_hoji = 3 Then
        p = Array(0#, 94.1, 5.9, 0#, 0#, 0#, 0#)
    ElseIf shichoukaku = 0# And A("2-13") = 1 And A("4-3") = 1 And A("4-31") = 1 And nijiku_nouryoku = 2 And shougai_kinsen = 3 Then
        p = Array(3.1, 87.5, 6.3, 3.1, 0#, 0#, 0#)
    ElseIf shichoukaku = 0# And A("2-13") = 1 And A("4-3") = 1 And A("4-17") = 1 And nijiku_nouryoku = 2 And shougai_kinsen = 3 Then
        p = Array(2.9, 85.7, 8.6, 2.8, 0#, 0#, 0#)
    ElseIf ouyou >= 0.1 And ouyou <= 32.9 And koudouA = 0# And A("2-14") = 2 And nijiku_nouryoku = 3 And shougai_kinsen = 3 Then
        p = Array(0#, 90.6, 3.1, 6.3, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou = 0# And koudouA = 0# And koudouC = 0# And (A("1-7") = 2 Or A("1-7") = 3) And A("2-8") = 1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(12.5, 75#, 12.5, 0#, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou >= 36.2 And ouyou <= 73.2 And koudouA >= 20.2 And koudouA <= 32.7 Then
        p = Array(0#, 1.9, 68.5, 27.8, 1.8, 0#, 0#)
    ElseIf seikatsu2 <= 10.6 And ouyou <= 36.1 And mahi_koushuku <= 8.7 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) Then
        p = Array(0#, 25.3, 67#, 7.7, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 36.1 And koudouA >= 21# And A("2-12") = 1 And A("4-3") >= 2 And A("4-3") <= 5 Then
        p = Array(0#, 6.8, 61.6, 26#, 4.1, 1.5, 0#)
    ElseIf kikyo <= 6.8 And seikatsu1 <= 4# And seikatsu2 <= 23.5 And ouyou <= 73.3 And koudouA <= 16.7 Then
        p = Array(0#, 0#, 60.5, 32.1, 7.4, 0#, 0#)
    ElseIf seikatsu2 >= 10.7 And seikatsu2 <= 23.5 And ouyou <= 36.1 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) Then
        p = Array(0#, 14.8, 53#, 32.2, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 10.6 And ouyou <= 36.1 And mahi_koushuku >= 8.8 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) And mahi_migi_ashi = 1 Then
        p = Array(0#, 6.1, 90.9, 3#, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 10.6 And ouyou <= 36.1 And mahi_koushuku >= 8.8 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) And mahi_hidari_ashi = 1 Then
        p = Array(0#, 6.1, 90.9, 3#, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 10.6 And ouyou <= 36.1 And mahi_koushuku >= 8.8 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) And (mahi_migi_ashi >= 2 And mahi_migi_ashi <= 4) Then
        p = Array(0#, 2.7, 80#, 17.3, 0#, 0#, 0#)
    ElseIf seikatsu2 <= 10.6 And ouyou <= 36.1 And mahi_koushuku >= 8.8 And A("4-3") = 1 And (mahi = 3 Or mahi = 4 Or mahi = 5) And (mahi_hidari_ashi >= 2 And mahi_hidari_ashi <= 4) Then
        p = Array(0#, 2.7, 80#, 17.3, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 = 0# And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 20.1 And A("4-3") >= 2 And A("4-3") <= 5 Then
        p = Array(0#, 4.3, 74.5, 20.2, 1#, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi >= 0.1 And koudouA <= 20.9 And koudouC <= 38.6 And A("4-3") >= 2 And A("4-3") <= 5 Then
        p = Array(0#, 8.7, 74.4, 15.3, 1.6, 0#, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi = 0# And koudouA <= 20.9 And A("4-3") >= 2 And A("4-3") <= 5 And A("4-4") >= 2 And A("4-4") <= 5 Then
        p = Array(0#, 2.8, 72.2, 20.8, 4.2, 0#, 0#)
    ElseIf seikatsu1 >= 15.6 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 20.1 And mahi_koushuku <= 7.1 Then
        p = Array(0#, 2.6, 59#, 35.9, 0#, 2.5, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi >= 0.1 And koudouA >= 20.9 And koudouC >= 38.7 And A("4-3") >= 2 And A("4-3") <= 5 Then
        p = Array(0.4, 5.9, 56.9, 30.5, 5.9, 0.4, 0#)
    ElseIf seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi = 0# And koudouA >= 20.9 And A("4-3") >= 2 And A("4-3") <= 5 And A("4-4") = 1 Then
        p = Array(0#, 43.7, 48.1, 8.2, 0#, 0#, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou <= 36.1 And koudouA >= 14.2 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(0#, 20.5, 42.2, 27.7, 9.6, 0#, 0#)
    ElseIf kikyo >= 0.1 And seikatsu1 <= 15.5 And seikatsu2 = 0# And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 20.1 And A("4-3") = 1 Then
        p = Array(0#, 11.3, 80.4, 8.3, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 8.4 And koudouC >= 38.7 Then
        p = Array(0#, 4.6, 53.8, 40#, 1.6, 0#, 0#)
    ElseIf seikatsu1 = 0# And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 20.1 And koudouC <= 38.6 And A("1-7") = 4 Then
        p = Array(0#, 0#, 74.1, 25.9, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB >= 0.1 And A("4-3") = 1 And A("4-29") >= 2 And A("4-29") <= 5 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku >= 3 And nijiku_nouryoku <= 5) Then
        p = Array(0#, 22.8, 68.4, 7.6, 1.2, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu1 <= 15.5 And seikatsu2 = 0# And ouyou >= 42.8 And ouyou <= 73.2 And koudouA <= 20.1 And koudouC <= 12.5 And A("4-3") = 1 Then
        p = Array(0#, 14.3, 67.9, 16.1, 1.7, 0#, 0#)
    ElseIf seikatsu1 >= 21# And seikatsu2 >= 23.6 And seikatsu2 <= 32.7 And ouyou <= 73.2 And ninchi >= 20.6 And koudouA >= 32.7 And A("1-4") = 1 And A("4-5") = 1 Then
        p = Array(0#, 1.1, 58.9, 34.7, 5.3, 0#, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou <= 36.1 And koudouA >= 0.1 And koudouA <= 14.1 And koudouC >= 14.1 And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(0.7, 32.7, 58#, 6.7, 1.3, 0.6, 0#)
    ElseIf kikyo = 0# And seikatsu1 <= 15.5 And seikatsu2 = 0# And ouyou >= 36.2 And ouyou <= 42.7 And koudouA <= 20.1 And koudouC >= 12.5 And A("4-3") = 1 Then
        p = Array(0#, 37.9, 56.9, 3.4, 1.8, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA >= 8.5 And koudouA <= 20.1 And koudouC >= 38.7 Then
        p = Array(0#, 0#, 55.4, 25.7, 18.9, 0#, 0#)
    ElseIf seikatsu1 <= 21# And seikatsu2 >= 23.6 And seikatsu2 <= 50.6 And ouyou <= 73.2 And ninchi <= 20.5 And koudouA <= 32.7 And A("1-4") = 1 And (A("1-7") = 2 Or A("1-7") = 3 Or A("1-7") = 4) Then
        p = Array(0#, 2.2, 52.2, 40#, 5.6, 0#, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou <= 36.1 And ninchi >= 10.8 And koudouA >= 0.1 And koudouA <= 14.1 And koudouC <= 14# And A("4-3") = 1 And (mahi = 1 Or mahi = 2) Then
        p = Array(0#, 43.5, 43.5, 11.8, 1.2, 0#, 0#)
    ElseIf seikatsu1 <= 21# And seikatsu2 >= 23.6 And seikatsu2 <= 50.6 And ouyou <= 73.2 And ninchi <= 20.5 And koudouA <= 32.7 And A("1-4") = 1 And A("1-7") = 1 And A("4-18") = 1 Then
        p = Array(2.8, 9.9, 74.3, 12.9, 0.9, 0#, 0#)
    ElseIf seikatsu1 <= 21# And seikatsu2 >= 23.6 And seikatsu2 <= 50.6 And ouyou <= 73.2 And ninchi <= 20.5 And koudouA <= 32.7 And A("1-4") = 1 And A("1-7") = 1 And A("4-18") >= 2 And A("4-18") <= 5 Then
        p = Array(0#, 4.6, 52.3, 38.5, 4.6, 0#, 0#)
    ElseIf seikatsu1 >= 0.1 And seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA <= 20.1 And koudouC <= 38.6 And A("1-7") = 4 Then
        p = Array(0#, 0#, 48.5, 47#, 4.5, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 51.6 And ninchi >= 19# And koudouA <= 20.1 And koudouC <= 38.6 And A("1-7") >= 1 And A("1-7") <= 3 And shougai_taijin >= 1 And shougai_taijin <= 3 Then
        p = Array(0#, 9.5, 77.8, 11.1, 1.6, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 51.7 And ouyou <= 73.2 And ninchi >= 19# And koudouA <= 20.1 And koudouC <= 38.6 And A("1-7") >= 1 And A("1-7") <= 3 And shougai_taijin >= 1 And shougai_taijin <= 3 Then
        p = Array(0#, 1.6, 70.5, 27.9, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA <= 20.1 And koudouC <= 38.6 And A("1-4") >= 2 And A("1-4") <= 4 And A("1-7") >= 1 And A("1-7") <= 3 Then
        p = Array(1.8, 0#, 67.2, 27.6, 3.4, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi >= 19# And koudouA <= 20.1 And koudouC <= 38.6 And A("1-7") >= 1 And A("1-7") <= 3 And shougai_taijin >= 4 And shougai_taijin <= 5 Then
        p = Array(0#, 3.4, 52.5, 44.1, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA <= 20.1 And koudouC = 0# And mahi_koushuku >= 0.1 And A("1-4") = 1 And A("1-7") >= 1 And A("1-7") <= 3 Then
        p = Array(0#, 2.1, 95.9, 2#, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA >= 1.6 And koudouA <= 20.1 And koudouC <= 38.6 And mahi_koushuku = 0# And A("1-4") = 1 And A("1-7") >= 1 And A("1-7") <= 3 Then
        p = Array(0#, 5.4, 81#, 10.9, 2.7, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA <= 20.1 And koudouC >= 0.1 And koudouC <= 38.6 And mahi_koushuku >= 0.1 And A("1-4") = 1 And A("1-7") >= 1 And A("1-7") <= 3 Then
        p = Array(0#, 7#, 75.4, 15.8, 1.8, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA <= 1.5 And koudouC <= 38.6 And mahi_koushuku = 0# And A("1-4") = 1 And A("1-7") >= 1 And A("1-7") <= 3 And (A("2-2") = 2 Or A("2-2") = 3) Then
        p = Array(0#, 20.7, 72.4, 6.9, 0#, 0#, 0#)
    ElseIf seikatsu1 <= 15.5 And seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And ninchi <= 18.9 And koudouA <= 1.5 And koudouC <= 38.6 And mahi_koushuku = 0# And A("1-4") = 1 And A("1-7") >= 1 And A("1-7") <= 3 And A("2-2") = 1 Then
        p = Array(0#, 43.9, 49.1, 7#, 0#, 0#, 0#)
    ElseIf A("2-3") = 1 And A("2-16") = 1 And mahi_migi_te = 3 Then
        p = Array(2.9, 11.4, 80#, 5.7, 0#, 0#, 0#)
    ElseIf A("2-3") = 1 And A("2-16") = 1 And mahi_hidari_te = 3 Then
        p = Array(2.9, 11.4, 80#, 5.7, 0#, 0#, 0#)
    ElseIf seikatsu1 = 0# And A("2-3") = 1 And A("5-3") = 2 Then
        p = Array(0#, 3.1, 84.8, 12.1, 0#, 0#, 0#)
    ElseIf A("1-2") = 1 And A("2-16") = 1 And A("5-3") = 2 Then
        p = Array(0#, 3#, 90.9, 6.1, 0#, 0#, 0#)
    ElseIf seikatsu1 = 0# And iryou >= 0.1 And iryou <= 3.7 And A("2-3") = 1 Then
        p = Array(0#, 2.1, 80.9, 17#, 0#, 0#, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 19.5 And shichoukaku >= 10.7 And shichoukaku <= 41.1 And ouyou >= 33# And ouyou <= 61.5 And A("2-16") = 3 Then
        p = Array(0#, 7.1, 88.1, 4.8, 0#, 0#, 0#)
    ElseIf A("2-16") = 1 And A("5-3") = 2 And koushuku_kata = 1 And koushuku_komata = 1 And koushuku_hiji = 1 And koushuku_hiza = 1 And koushuku_sonota = 1 Then
        p = Array(0#, 3#, 88.2, 8.8, 0#, 0#, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA >= 20.2 And koudouA <= 32.7 And A("2-8") = 1 Then
        p = Array(0#, 0#, 50#, 42.9, 0#, 7.1, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 23.5 And ouyou >= 36.2 And ouyou <= 73.2 And koudouA >= 20.2 And koudouA <= 32.7 And A("2-15") = 1 Then
        p = Array(0#, 0#, 55.6, 27.8, 11.1, 5.5, 0#)
    ElseIf seikatsu2 >= 0.1 And seikatsu2 <= 19.5 And ouyou >= 33# And ouyou <= 61.5 And ninchi >= 0.1 And ninchi <= 13.1 And (A("3-1") = 4 Or A("3-1") = 5) Then
        p = Array(0#, 12.3, 82.5, 3.5, 1.7, 0#, 0#)
    ElseIf kikyo = 0# And seikatsu1 >= 21.1 And seikatsu2 >= 23.6 And seikatsu2 <= 34.8 And ouyou <= 69.4 And koudouA <= 30.2 And koudouC <= 24.7 And (A("1-4") = 1 Or A("1-4") = 2) Then
        p = Array(0#, 0#, 60.7, 39.3, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB >= 0.1 And A("4-1") = 3 And A("4-3") = 1 And A("4-29") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku = 1 Or nijiku_nouryoku = 4 Or nijiku_nouryoku = 5) Then
        p = Array(0#, 40#, 50#, 10#, 0#, 0#, 0#)
    ElseIf seikatsu2 = 0# And ouyou <= 36.1 And koudouA >= 0.1 And koudouB >= 0.1 And A("4-3") = 1 And hankouteki = 5 And A("4-29") = 1 And (mahi = 1 Or mahi = 2) And (nijiku_nouryoku >= 3 And nijiku_nouryoku <= 5) Then
        p = Array(0#, 35.7, 57.1, 0#, 7.2, 0#, 0#)
    Else
        matched = False ' 80ルールのいずれにも合致しなかった場合
    End If

    ' 5. ルール外の場合の概算（フォールバック）処理
    If matched = False Then
        Dim totalScore As Double
        totalScore = kikyo + seikatsu1 + seikatsu2 + ouyou + ninchi + koudouA + koudouB + koudouC + shichoukaku + iryou + mahi_koushuku

        If totalScore = 0 Then
            p = Array(95#, 5#, 0#, 0#, 0#, 0#, 0#)
        ElseIf totalScore < 40 Then
            p = Array(60#, 30#, 10#, 0#, 0#, 0#, 0#)
        ElseIf totalScore < 90 Then
            p = Array(10#, 40#, 40#, 10#, 0#, 0#, 0#)
        ElseIf totalScore < 160 Then
            p = Array(0#, 10#, 30#, 45#, 15#, 0#, 0#)
        ElseIf totalScore < 240 Then
            p = Array(0#, 0#, 10#, 30#, 45#, 15#, 0#)
        ElseIf totalScore < 320 Then
            p = Array(0#, 0#, 0#, 10#, 30#, 45#, 15#)
        Else
            p = Array(0#, 0#, 0#, 0#, 10#, 40#, 50#)
        End If
        
        ' 特例補正
        If (koudouA + koudouB + koudouC) > 50 Then
            p = Array(0#, 0#, 5#, 15#, 40#, 30#, 10#)
        ElseIf iryou > 15 Then
            p = Array(0#, 0#, 0#, 10#, 20#, 40#, 30#)
        End If
    End If

    ' 6. 結果をExcelシートに出力（F2?F8）
    Dim i As Integer
    For i = 0 To 6
        ws.Range("F" & (i + 2)).Value = p(i) & "%"
    Next i
    
    MsgBox "シミュレーションが完了しました！", vbInformation, "計算完了"
End Sub

' ▼▼ 補助関数：回答値の取得と、各パターンのスコア変換 ▼▼

Function A(id As String) As Integer
    If dictAns.Exists(id) Then
        A = dictAns(id)
    Else
        A = 1 ' 未入力やエラーの場合はデフォルトで1とする
    End If
End Function

Function ScoreA(val As Integer) As Double
    Select Case val
        Case 1: ScoreA = 0#
        Case 2: ScoreA = 7.8
        Case 3: ScoreA = 10.4
        Case 4: ScoreA = 14.8
        Case Else: ScoreA = 0#
    End Select
End Function

Function Score2(val As Integer) As Double
    Select Case val
        Case 1: Score2 = 0#
        Case 2: Score2 = 5#
        Case Else: Score2 = 0#
    End Select
End Function

Function Score3(val As Integer) As Double
    Select Case val
        Case 1: Score3 = 0#
        Case 2: Score3 = 6.2
        Case 3: Score3 = 15#
        Case Else: Score3 = 0#
    End Select
End Function

Function Score5(val As Integer) As Double
    Select Case val
        Case 1: Score5 = 0#
        Case 2: Score5 = 1#
        Case 3: Score5 = 3#
        Case 4: Score5 = 5#
        Case 5: Score5 = 10#
        Case Else: Score5 = 0#
    End Select
End Function

Function Score6(val As Integer) As Double
    Select Case val
        Case 1: Score6 = 0#
        Case 2: Score6 = 1#
        Case 3: Score6 = 2#
        Case 4: Score6 = 4#
        Case 5: Score6 = 7#
        Case 6: Score6 = 10#
        Case Else: Score6 = 0#
    End Select
End Function

コピペができたら、「×」ボタンでVisual Basicの画面を閉じてしまってOKです。

4. シミュレーション実行ボタンを準備

最後に選択した回答でシミュレーションを実行するためのボタンを用意しましょう。

以下手順のどちらかでボタンを準備できます。どちらでもOKです。お好きな方を選んでください。

【手順A】

  1. 開発タブの挿入からボタン（フォームコントロール）を押下
  2. 「＋」マークが表示されるので左クリックを押下しながら四角形を作成
  3. マクロ名「RunSimulation」を選択してOKを押下

【手順B】

  1. 挿入タブの図形から適当な図形を選択
  2. 「＋」マークが表示されるので左クリックを押下しながら図形を作成
  3. 図形を右クリックして「マクロの登録」を押下
  4. マクロ名「RunSimulation」を選択してOKを押下

これでボタンも完成です。

適当に回答を選択してボタンを押してみてください。計算されると思います。

5. 名前を付けて保存

これで完成なので最後に名前を付けて保存しましょう。

ファイルタブから名前を付けて保存でOKで、どこに保存してもOKなのですが、1点注意点として、ファイルの種類をExcelマクロ有効ブック（*.xlsm）にする必要があります。

Excelのマクロ（プログラムコード）を使うためにはこれで保存しないといけないので必ず忘れずに、間違いないように実施しましょう。

最後に

さて今回は、障害支援区分のシミュレーションツールを作って展開しました。

前回作ったWEBアプリよりかは、かなり難易度低め、誰でも簡単に使えるようになっているはずです。

是非ご活用ください。

以上！

他にも勉強記事をあげているので是非！

水管理デバイスの試作【農業IoT・AgriTechデバイス開発#9】
はじめに計画通りに進めていても記事の投稿にラグがある可能性がありますが、悪しからず。まあ、計画通りに進められていない場合もありますが・・・前回の記事では、水管理デバイスを構想してみました。今回は水管理デバイスの試作に取り組んでみようかと思い...
nlab-notebook.com
2026.02.02
【2024年版】作業効率UP！PCデスク周りおすすめアイテム紹介！
デスク周りを快適にするための最新ガジェットを厳選して紹介。作業効率をアップさせる便利なアイテムが満載で、あなたの作業環境を一新します。あなたのデスクにぴったりのアイテムを見つけましょう！
nlab-notebook.com
2024.08.02
【NotebookLM】使い方まとめ｜特徴・できること・始め方を画像で解説
NotebookLMの基本機能や使い方を初心者向けに画像付きで丁寧に解説。対応ファイル形式や注意点も詳しく紹介し、学習や仕事にも幅広く活用できる実践的な入門ガイドとしてまとめています。
nlab-notebook.com
2025.12.08

コメント

タイトルとURLをコピーしました