上記質問でマクロを教えて頂き、データを作成することが出来ましたが、新たに問題発生でいくつか質問させていただきます。
第5週土曜日が存在する時は事業所名を「みのり様」にしたいんですが、どこを直したらよいのか解りません。また、第5週土曜日がないときは当月最後の日曜日にしたいのですが、何故か11月のマクロ実行しましたら「11月22日」になってしまって第3週の日曜日だった状態でした。これをどう修正してよいのかも解りません。
更に第2土曜日のみ16:30ではなく、16:00としたいのですがこちらも上手くいきません。
是非教えてください。全てお答えいただきましたらポイントは100ポイント加算させていただきます
変更点は3つ。
1 第5週土曜日が存在する時は事業所名を「みのり様」にしたい
→第5土曜を判別するコードの後に「みのり様」を書き込みます。
とりあえず13:00~か16:30~のどちらかなのか、両方なのかがわからないので両方にしておきます。
2 第5週土曜日がないときは当月最後の日曜日にしたい
これは第5土曜日があるときは第4日曜(11月22日は第4日曜です)にしている仕様でそうなります。
最後の日曜にすればいいわけですね。
→第5日曜があるかどうかを調べ最終日曜が第4週か第5週かを調べます。
3 第2土曜日のみ16:30ではなく、16:00としたい
→16:00を書き込む部分を第何週かを判別した後に変更します。
以下に変更を加えたコードを掲載します。変更箇所がわかるようにしておきました。
Sub 表の作成() Dim myDate As Date Dim myDate2 As Date Dim myMonth As String Dim i As Integer Dim check As Boolean Dim check2 As Boolean Dim lastSun As Integer If Selection.Column <> 1 Then Exit Sub If IsDate(Selection.Value) Then myDate = Selection.Value Else Exit Sub End If myMonth = Month(myDate) '第5土曜日があるかどうかを判別 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 '第5日曜日があるかどうかを判別・・・1の変更 For i = 29 To 31 myDate2 = DateSerial(Year(myDate), Month(myDate), i) If Weekday(myDate2) = 1 And Month(myDate2) = myMonth Then check2 = True Exit For End If Next i If check2 Then lastSun = 5 Else lastSun = 4 End If i = 0 While Month(myDate) = myMonth Selection.Offset(i, 0).Value = myDate '日曜日ではないか、第5土曜の無い最終日曜日のときだけ実行 If Weekday(myDate) <> 1 Or (Weekday(myDate) = 1 And check = False And _ Int((Day(myDate) - 1) / 7) + 1 = lastSun) 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 myDate2 As Date Dim res As Integer Dim check As Boolean 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, 6).Value = "移動介助" Target.Offset(1, 7).Value = "森田ケアーズ蔵前様" '実際のケースに変更 Target.Offset(1, 12).Value = "移動支援" res = 2 '第何週かで分岐 Select Case Int((Day(myDate) - 1) / 7) + 1 Case 1 Target.Offset(1, 2).Value = "16:30" Target.Offset(1, 4).Value = "21:30" Target.Offset(1, 5).Value = "5:00" Case 2 'ここで第2土曜であることがわかるので16:00に・・・3の変更 Target.Offset(1, 2).Value = "16:00" Target.Offset(1, 4).Value = "17:30" Target.Offset(1, 5).Value = "1:30" 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, 2).Value = "16:30" Target.Offset(1, 4).Value = "23:00" Target.Offset(1, 5).Value = "6:30" Case 5 Target.Offset(1, 2).Value = "16:30" Target.Offset(1, 4).Value = "21:30" Target.Offset(1, 5).Value = "5:00" 'ここで第5土曜であることがわかるので「みのり様」を上書き・・・2の変更 Target.Offset(0, 7).Value = "みのり様" Target.Offset(1, 7).Value = "みのり様" End Select End Select myMacro = res End Function
SALINGER 様
いつも本当にありがとうございます!!
まさしく私のイメージどおりです!感動して来年の3月まで予定作ってしまったほどです。
すごく嬉しいです。
まだまだ加えたい点があって別の質問を立てる予定ですが、今のこの状態でも今まで異常に早く予定表が作成できます。
コード修正の修正大変だったと思います。気持ち程度ですがポイント加算させていただきますね。
本当に本当にありがとうございました。