Ｓ・Ｍ・C (Ｓｉｍｐｌｅ.Ｍａｃｒｏ.Ｃｒｅａｔｅ)　～エクセルマクロ日記～

前回からの続きです。

介護事業所（デイサービス）で作られる、介護予防実績報告書の事務改善について書いています。

３日かかる仕事を１０分、いや５分で片づけようというものです。

実績報告書の項目をすべて編集します。


７０％完成でしょうか。



プログラムはこんな感じでしょうか。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　Dim obj As Object
　　 r = Target.Row

　対象者 = Sheets("対象者名簿").Range("d" & r)

　Set obj = Workbooks("実績.xlsx").Worksheets("実績データ").Cells.Find(対象者)

If obj Is Nothing Then

MsgBox 対象者 & "　実績がありません"
Sheets("対象者名簿").Select

Else

Call 項目クリア

Call 編集(r)

For cnt = 1 To 31

If obj.Offset(0, cnt) = "" Then
Else
Worksheets("実績報告書").Range("l12").Offset(0, cnt) = 1 '実績報告書の利用日を編集

End If

Next cnt

Worksheets("実績報告書").Select

End If

End Sub

'・・・・実績報告書の編集項目をクリアする処理

Sub 項目クリア()
'
With Worksheets("実績報告書")

.Range("e8") = ""
.Range("e6") = ""
.Range("e4") = ""
.Range("r4") = ""
.Range("b12") = ""
.Range("c13") = ""

.Range("r6") = ""
.Range("E12") = ""
.Range("E14") = ""
.Range("E16") = ""
.Range("E18") = ""
.Range("E20") = ""

.Range("B25") = ""
.Range("I25") = ""
.Range("N25") = ""

.Range("B27") = ""
.Range("I27") = ""
.Range("N27") = ""

.Range("B29") = ""
.Range("I29") = ""
.Range("N29") = ""

.Range("B31") = ""
.Range("I31") = ""
.Range("N31") = ""

.Range("B33") = ""
.Range("I33") = ""
.Range("N33") = ""

.Range("n12:ar20") = ""
End With

End Sub


'実績報告書の項目を編集する処理
' 変数 r は　行番号
Sub 編集(r) '
With Worksheets("実績報告書")
.Range("e8") = Sheets("対象者名簿").Range("d" & r)
.Range("e6") = Sheets("対象者名簿").Range("e" & r)
.Range("e4") = Sheets("対象者名簿").Range("f" & r)
.Range("r4") = Sheets("対象者名簿").Range("g" & r)
.Range("b12") = Sheets("対象者名簿").Range("h" & r)
.Range("c13") = Sheets("対象者名簿").Range("i" & r)

介護度 = Sheets("対象者名簿").Range("g" & r)

Select Case 介護度

Case "要支援１"
.Range("r6").Value = "49700"
.Range("E12").Value = "予防通所介護１"
.Range("E14").Value = "運動器機能向上加算"
.Range("E16").Value = "事業所評価加算"
.Range("E18").Value = "サービス提供体制加算Ⅱ１"
.Range("E20").Value = "介護処遇改善加算Ⅰ"

.Range("B25").Value = "予防通所介護１"
.Range("I25").Value = "651111"
.Range("N25").Value = "2099"

.Range("B27").Value = "運動器機能向上加算"
.Range("I27").Value = "655002"
.Range("N27").Value = "225"

.Range("B29").Value = "事業所評価加算"
.Range("I29").Value = "655005"
.Range("N29").Value = "120"

.Range("B31").Value = "サービス提供体制加算Ⅱ１"
.Range("I31").Value = "656103"
.Range("N31").Value = "24"

.Range("B33").Value = "介護処遇改善加算Ⅰ"
.Range("I33").Value = "656111"
.Range("N33").Value = "46.892"


Case "要支援２"
.Range("r6").Value = "104000"
.Range("e12").Value = "予防通所介護２"
.Range("e14").Value = "運動器機能向上加算"
.Range("E16").Value = "事業所評価加算"
.Range("e18").Value = "サービス提供体制加算Ⅱ２"
.Range("E20").Value = "介護処遇改善加算Ⅰ"

.Range("B25").Value = "予防通所介護２"
.Range("i25").Value = "651121"
.Range("n25").Value = "4205"

.Range("B27").Value = "運動器機能向上加算"
.Range("i27").Value = "655002"
.Range("n27").Value = "225"

.Range("B29").Value = "事業所評価加算"
.Range("I29").Value = "655005"
.Range("N29").Value = "120"

.Range("B31").Value = "サービス提供体制加算Ⅱ２"
.Range("i31").Value = "656104"
.Range("n31").Value = "48"

.Range("B33").Value = "介護処遇改善加算Ⅰ"
.Range("I33").Value = "656111"
.Range("N33").Value = "87.362"


End Select
End With
End Sub

ダブルクリックをすると、実績報告書を編集するという処理は完成しました。

次に、印刷処理の機能を作っていきます。
もちろん、一件毎の印刷はできるようにしますが、
一気に５０件分を、ボタンひとつで印刷できれば、
時短につながる事間違いなし。

３日の仕事が５分で！・・・夢のような話です。

まだまだ細かい機能を追加していきます。

お楽しみに