Sub 表の作成()
Dim myDate As Date
Dim myDate2 As Date
Dim myMonth As String
Dim i As Integer
Dim check As Boolean
If Selection.Column <> 1 Then Exit Sub
If IsDate(Selection.Value) Then
myDate = Selection.Value
Else
Exit Sub
End If
myMonth = Month(myDate)
For i = 29 To 31
myDate2 = DateSerial(Year(myDate), Month(myDate), i)
If Weekday(myDate2) = 7 And Month(myDate2) = myMonth Then
check = True
Exit For
End If
Next i
i = 0
While Month(myDate) = myMonth
Selection.Offset(i, 0).Value = myDate
If Weekday(myDate) <> 1 Or (Weekday(myDate) = 1 And check = False And _
Int((Day(myDate) - 1) / 7) + 1 = 4) Then
i = i + myMacro(Selection.Offset(i, 0))
End If
myDate = myDate + 1
Wend
End Sub
Function myMacro(Target As Range) As Integer
Dim myDate As Date
Dim res As Integer
res = 1
myDate = Target.Value
Range(Cells(Target.Row, 3), Cells(Target.Row, 4)).Merge
Target.Offset(0, 2).HorizontalAlignment = xlCenter
Range(Cells(Target.Row, 2), Cells(Target.Row, 13)).ClearContents
Select Case Application.WorksheetFunction.Weekday(myDate)
Case 1
Target.Offset(0, 1).Value = "日"
Target.Offset(0, 2).Value = "14:00"
Target.Offset(0, 4).Value = "19:00"
Target.Offset(0, 5).Value = "5:00"
Target.Offset(0, 6).Value = "移動介助"
Target.Offset(0, 7).Value = "みのり様"
Target.Offset(0, 8).Value = "家"
Target.Offset(0, 12).Value = "移動支援"
Case 2
Target.Offset(0, 1).Value = "月"
Target.Offset(0, 2).Value = "20:00"
Target.Offset(0, 4).Value = "20:30"
Target.Offset(0, 5).Value = "0:30"
Target.Offset(0, 6).Value = "移動介護"
Target.Offset(0, 7).Value = "みのり様"
Target.Offset(0, 8).Value = "家"
Target.Offset(0, 9).Value = "⇔"
Target.Offset(0, 10).Value = "レンタルショップ"
Target.Offset(0, 11).Value = "徒歩"
Target.Offset(0, 12).Value = "移動支援"
Range(Cells(Target.Row + 1, 3), Cells(Target.Row + 1, 4)).Merge
Target.Offset(1, 2).HorizontalAlignment = xlCenter
Range(Cells(Target.Row + 1, 1), Cells(Target.Row + 1, 13)).ClearContents
Target.Offset(1, 0).Value = Target.Value
Target.Offset(1, 1).Value = "月"
Target.Offset(1, 2).Value = "20:30"
Target.Offset(1, 4).Value = "21:00"
Target.Offset(1, 5).Value = "0:30"
Target.Offset(1, 6).Value = "身体介護"
Target.Offset(1, 7).Value = "みのり様"
Target.Offset(1, 12).Value = "居宅介護"
res = 2
Case 3
Target.Offset(0, 1).Value = "火"
Target.Offset(0, 2).Value = "18:30"
Target.Offset(0, 4).Value = "19:30"
Target.Offset(0, 5).Value = "1:00"
Target.Offset(0, 6).Value = "身体介護"
Target.Offset(0, 7).Value = "森田ケアーズ蔵前様"
Target.Offset(0, 12).Value = "居宅介護"
Case 4
Target.Offset(0, 1).Value = "水"
Target.Offset(0, 2).Value = "18:30"
Target.Offset(0, 4).Value = "19:30"
Target.Offset(0, 5).Value = "1:00"
Target.Offset(0, 6).Value = "身体介護"
Target.Offset(0, 7).Value = "あやの実ヘルパーステーション様"
Target.Offset(0, 12).Value = "居宅介護"
Case 5
Target.Offset(0, 1).Value = "木"
Target.Offset(0, 2).Value = "18:30"
Target.Offset(0, 4).Value = "19:30"
Target.Offset(0, 5).Value = "1:00"
Target.Offset(0, 6).Value = "身体介護"
Target.Offset(0, 7).Value = "支援センター様"
Target.Offset(0, 12).Value = "居宅介護"
Case 6
Target.Offset(0, 1).Value = "金"
Target.Offset(0, 2).Value = "19:00"
Target.Offset(0, 4).Value = "21:00"
Target.Offset(0, 5).Value = "2:00"
Target.Offset(0, 6).Value = "移動介助"
Target.Offset(0, 7).Value = "森田ケアーズ蔵前様"
Target.Offset(0, 8).Value = "家"
Target.Offset(0, 10).Value = "松が谷福祉会館"
Target.Offset(0, 11).Value = "徒歩"
Target.Offset(0, 12).Value = "移動支援"
Case 7
Target.Offset(0, 1).Value = "土"
Target.Offset(0, 2).Value = "13:00"
Target.Offset(0, 4).Value = "15:00"
Target.Offset(0, 5).Value = "2:00"
Target.Offset(0, 6).Value = "身体介護"
Target.Offset(0, 7).Value = "あやの実ヘルパーステーション様"
Target.Offset(0, 12).Value = "居宅介護"
Range(Cells(Target.Row + 1, 3), Cells(Target.Row + 1, 4)).Merge
Target.Offset(1, 2).HorizontalAlignment = xlCenter
Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 13)).ClearContents
Target.Offset(1, 0).Value = Target.Value
Target.Offset(1, 1).Value = "土"
Target.Offset(1, 2).Value = "16:30"
Target.Offset(1, 6).Value = "移動介助"
Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"
Target.Offset(1, 12).Value = "移動支援"
res = 2
Select Case Int((Day(myDate) - 1) / 7) + 1
Case 1, 5
Target.Offset(1, 4).Value = "21:30"
Target.Offset(1, 5).Value = "5:00"
Case 2
Target.Offset(1, 4).Value = "17:30"
Target.Offset(1, 5).Value = "1:00"
Range(Cells(Target.Row + 2, 3), Cells(Target.Row + 2, 4)).Merge
Target.Offset(2, 2).HorizontalAlignment = xlCenter
Range(Cells(Target.Row + 2, 2), Cells(Target.Row + 2, 13)).ClearContents
Target.Offset(2, 0).Value = Target.Value
Target.Offset(2, 1).Value = "土"
Target.Offset(2, 2).Value = "19:30"
Target.Offset(2, 4).Value = "23:00"
Target.Offset(2, 5).Value = "3:30"
Target.Offset(2, 6).Value = "移動介助"
Target.Offset(2, 7).Value = "森田ケアーズ蔵前様"
Target.Offset(2, 8).Value = "手話サークル"
Target.Offset(2, 10).Value = "家"
Target.Offset(2, 11).Value = "日比谷線千代田線"
Target.Offset(2, 12).Value = "移動支援"
res = 3
Case 3, 4
Target.Offset(1, 4).Value = "23:00"
Target.Offset(1, 5).Value = "6:30"
End Select
End Select
myMacro = res
End Function
