ケアマネのエクセルスキルをレベルアップ！VBAで業務効率書類を作る

エクセルスキルをレベルアップさせたケアマネのたっつん（＠enjoywelfare)です。

今日はケアマネジャーが仕事で使うリ・アセスメント支援シートをエクセルのVBAの機能でカスタマイズして使いやすくしました。

リ・アセスメント支援シートとは介護支援専門員が面接で得た情報（状態・問題（困りごと）・意向）と介護支援専門員側の判断を記載することで、自らのアセスメントを振り返るとともに、ケアプラン第2表の「生活全般の解決すべき課題（ニーズ）が適切か検討するための書類
保険者と介護支援専門員が共に行うケアマネジメントの質の向上ガイドラインより

この記事が役に立つ人

◆ケアマネでエクセルのスキルをレベルアップしたい方
◆東京都の介護支援専門員の更新研修でリ・アセスメント支援シートを使った課題がある方。
◆リ・アセスメントシートでケアプランの見直しをしたい方。
◆リ・アセスメント支援シートを使ってみたい方。
◆いつもリ・アセスメント支援シートを使っていて、項目に〇をつけるのが面倒だと思っている方。

東京都では介護支援専門員の更新研修や主任介護支援専門員の研修の時にリ・アセスメント支援シートを作成する提出課題があります。

このリ・アセスメント支援シートは東京都福祉保健局の「保険者と介護支援専門員が共に行うケアマネジメントの質の向上ガイドライン」のページからエクセルのファイルででダウンロードできますが、〇を着けるのが面倒です。

挿入→図→図形→楕円形を選び、丸を付けたい語句に大きさを合わせて右クリックして塗りつぶしなしを選択する。

一度、楕円を作成すればあとはコピペで楕円の作成ができますが、なんといっても位置と大きさを合わせるのが面倒くさい。

そこで、クリックするだけで大きさも丁度良い〇が選択されるリ・アセスメント支援シート（睡眠時間のところは選択すると自動で⇔が入る）の作り方を紹介します。

VBAで〇が自動で付くリ・アセスメント支援シート
1. VBAの機能で作成する。
2. VBAのコードを記載していく
ケアマネのエクセルスキルをレベルアップ：まとめ

VBAで〇が自動で付くリ・アセスメント支援シート

最初に東京都福祉保健局からリアセスメント支援シートをダウンロードします。

リアセスメント支援シートダウンロード

VBAの機能で作成する。

VBA【 Visual Basic for Applications 】とは、Microsoft Officeに含まれるアプリケーションソフトの拡張機能で、利用者が簡易なプログラムを記述して実行することで複雑な処理の自動化などを行なうことができるもの。また、そのために用意されたプログラミング言語。
Microsoft社のOfficeシリーズのソフトウェアの一部であるWordやExcel、Access、PowerPointなどで利用できる機能で、同社のプログラミング言語および実行環境であるVisual Basicの簡易版を用いてプログラムを作成することができる。これらのソフトウェアの動作の一部を変更したり、繰り返し行われる定型的な作業や複雑な処理を自動的に実行することができる。
引用元：IT用語辞典 e-Words http://e-words.jp/w/VBA.html

エクセルのVBAの機能を使って作っていきます。

まずは左上のファイルを押して、下の方のオプションをクリックします。

そうすると以下の画面になります。

①リボンユーザーの設定をクリック

②開発をクリックし✔にします

③OKをクリック

開発タブが出てきます。

①の開発タブをクリックして

②のＶisual Basicのボタンをクリックしてください

そうすると以下のような画面が開きます。

sheet1(No1)を選択し、①の部分をSelectionChangeにします。この作業はsheet1(No1)～sheet4(No4）まで一緒です。

VBAのコードを記載していく

sheet1(No1)からsheet4(No4)までをクリックしてそれぞれ②の部分にコードを書き込んでいきます。

sheet1(No1)の②の部分に以下のコードを記入します。（コピペでOK）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim MyTarget As Range

 Set MyTarget = Application.Intersect _
 (Target, Range("G5:Q5, G7, K7,G8:Q8,G10,K10,G11,K11,G12:Q12,G22:S27,G28:AH28,G32:AA32,G41:W41,G45:S45,G49:K49,BK8:BT8,CC8,BK11:BT11,CC11,BK20:BT20,CC20,BK26:BT26,CC26,BK31:BT31,CC31,BK39:BT39,CC39,BK44:BT44,CC44,BK49:BT49,CC49,BK60:BT60,CC60"))

    If Not MyTarget Is Nothing Then
        With ActiveSheet.Shapes.AddShape(msoShapeOval, _
            Target.Left, _
            Target.Top, _
            Target.Width, _
            Target.Height)
            .Fill.Visible = msoFalse
            .Line.Weight = 0.75
        End With
    End If
End Sub

sheet2(No2)の②の部分に以下のコードを記入します。（コピペでOK）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

 Dim MyTarget As Range
 Dim MyTarget2 As Range
 Dim R As Range
 

 Set MyTarget = Application.Intersect(Target, Range("G7:J22,M10:M14,M18:S20,G21:M22,G24:M25,L27,O27,BA12:BJ12,BS12,BA22:BJ22,BS22,BA43:BJ43,BS43"))
 Set MyTarget2 = Application.Intersect(Target, Range("G31:AF32"))
 Set R = Selection

    If Not MyTarget Is Nothing Then
        With ActiveSheet.Shapes.AddShape(msoShapeOval, _
            Target.Left, _
            Target.Top, _
            Target.Width, _
            Target.Height)
            .Fill.Visible = msoFalse
            .Line.Weight = 0.75
        End With
        
    ElseIf Not MyTarget2 Is Nothing Then
         With ActiveSheet.Shapes.AddLine(R.Left, R.Top + R.Height / 2, R.Left + R.Width, R.Top + R.Height / 2).Line
            .ForeColor.RGB = RGB(0, 0, 0)
            .Style = 1
            .BeginArrowheadStyle = 2
            .EndArrowheadStyle = 2
            .Weight = 3
        End With
     
    End If
    
        
End Sub

sheet3(No3)の②の部分に以下のコードを記入します。（コピペでOK）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim MyTarget As Range

 Set MyTarget = Application.Intersect _
 (Target, Range("G5:P8,G9:T10,G11,I11,G12:M19,G20:O20,G25:M33,G34,G35,AZ9:BI9,BP9,AZ13:BI13,BP13,AZ24:BI24,BP24,AZ28:BI28,BP28,A31:BI31,BP31,AZ37:BI37,BP37"))

    If Not MyTarget Is Nothing Then
        With ActiveSheet.Shapes.AddShape(msoShapeOval, _
            Target.Left, _
            Target.Top, _
            Target.Width, _
            Target.Height)
            .Fill.Visible = msoFalse
            .Line.Weight = 0.75
        End With
    End If
End Sub

sheet4(No4)の②の部分に以下のコードを記入します。（コピペでOK）

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim MyTarget As Range

 Set MyTarget = Application.Intersect _
 (Target, Range("G5:I9,AU8:BB8,BG8,AU8:BB8,BG8,AU12:BB12,BG12,AU19:BB19,BG19,AU23:BB23,BG23,AU27:BB27,BG27,AU34:BB34,BG34"))

    If Not MyTarget Is Nothing Then
        With ActiveSheet.Shapes.AddShape(msoShapeOval, _
            Target.Left, _
            Target.Top, _
            Target.Width, _
            Target.Height)
            .Fill.Visible = msoFalse
            .Line.Weight = 0.75
        End With
    End If
End Sub

あとは保存するときにマクロ有効ブックを選んで

好きな名前を付けて保存すれば完成です！