http://q.hatena.ne.jp/1252383605#comment

上記質問でマクロを教えて頂き、データを作成することが出来ましたが、新たに問題発生でいくつか質問させていただきます。
第5週土曜日が存在する時は事業所名を「みのり様」にしたいんですが、どこを直したらよいのか解りません。また、第5週土曜日がないときは当月最後の日曜日にしたいのですが、何故か11月のマクロ実行しましたら「11月22日」になってしまって第3週の日曜日だった状態でした。これをどう修正してよいのかも解りません。
更に第2土曜日のみ16:30ではなく、16:00としたいのですがこちらも上手くいきません。
是非教えてください。全てお答えいただきましたらポイントは100ポイント加算させていただきます

回答の条件
  • 1人2回まで
  • 登録:2009/09/16 12:54:21
  • 終了:2009/09/17 16:43:04

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/09/16 14:48:17

ポイント260pt

変更点は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
id:kanachan

SALINGER 様

いつも本当にありがとうございます!!

まさしく私のイメージどおりです!感動して来年の3月まで予定作ってしまったほどです。

すごく嬉しいです。

まだまだ加えたい点があって別の質問を立てる予定ですが、今のこの状態でも今まで異常に早く予定表が作成できます。

コード修正の修正大変だったと思います。気持ち程度ですがポイント加算させていただきますね。

本当に本当にありがとうございました。

2009/09/17 16:41:42

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません