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

Question

kanachan

73

73もっと見る

80pt

コンピュータ

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

上記質問をさせていただいたことがありますが、一部変更したくコード修正したいのですが方法が解りません。

ケース1
毎週金曜日の介助時間を変更
18：30～20：00
22：00～23：30

ケース2
第１土曜日の介助時間変更
16：30～19：00
21：00～23：30

ケース３
第２土曜日を変更
16：00～17：30
19：30～21：30
次の日の日曜日
21：30～23：00

ケース４
第３、第４土曜日を変更
16：30～18：30
20：30～23：00
次の日の日曜日
21：00～23：00

コードをどのように修正したらよいのでしょうか？よろしくお願い致します。

回答の条件

1人2回まで

登録：2009/12/06 15:06:26
終了：2009/12/13 14:23:44

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

SALINGER 2009/12/06 19:01:48

うお。
コードが長くてちょんぎれたみたいですね。
SALINGER 2009/12/06 19:07:06

これくらいの行数ならまだ大丈夫と思ってたのですが。
こちらに全文を掲載したました。
http://d.hatena.ne.jp/SALINGER/20091206
SALINGER 2009/12/06 20:08:08

ブログの方に、毎週土曜日の13：00～15：00を追加しました。

SALINGERの日記 2009-12-06 19:04:23

http://q.hatena.ne.jp/1260079584 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(Sel
人力検索はてな http://q.hatena.ne.jp/1260079584 以前に.. 2010-02-28 16:26:07

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

SALINGER · Accepted Answer · 2009-12-06T17:23:45+09: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)
    
    '第５土曜日があるかどうかを判別
    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
    
    '第５日曜日があるかどうかを判別
    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
        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 = "18:30"
            Target.Offset(0, 4).Value = "20:00"
            Target.Offset(0, 5).Value = "1:30"
            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 = "移動支援"
            
            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 = "22:00"
            Target.Offset(1, 4).Value = "23:30"
            Target.Offset(1, 5).Value = "1:30"
            Target.Offset(1, 6).Value = "身体介護"
            Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"
            Target.Offset(1, 12).Value = "居宅介護"
            res = 2
        Case 7
            '第何週かで分岐
            Select Case Int((Day(myDate) - 1) / 7) + 1
                Case 1
        '-----------------------------------------------------------------土曜第１週１回目
                    Target.Offset(0, 1).Value = "土"
                    Target.Offset(0, 2).Value = "16:30"
                    Target.Offset(0, 4).Value = "19:00"
                    Target.Offset(0, 5).Value = "2:30"
                    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 = "21:00"
                    Target.Offset(1, 4).Value = "23:30"
                    Target.Offset(1, 5).Value = "2:30"
                    Target.Offset(1, 6).Value = "移動介助"
                    Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 12).Value = "移動支援"
                    res = 2
                Case 2
        '-----------------------------------------------------------------土曜第２週１回目
                    Target.Offset(0, 1).Value = "土"
                    Target.Offset(0, 2).Value = "16:00"
                    Target.Offset(0, 4).Value = "17:30"
                    Target.Offset(0, 5).Value = "1:30"
                    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 = "19:30"
                    Target.Offset(1, 4).Value = "21:30"
                    Target.Offset(1, 5).Value = "2:00"
                    Target.Offset(1, 6).Value = "移動介助"
                    Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 12).Value = "移動支援"
                    
                    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 + 1
                    Target.Offset(2, 1).Value = "日"
                    Target.Offset(2, 2).Value = "21:30"
                    Target.Offset(2, 4).Value = "23:00"
                    Target.Offset(2, 5).Value = "1: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(0, 1).Value = "土"
                    Target.Offset(0, 2).Value = "16:30"
                    Target.Offset(0, 4).Value = "18:30"
                    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(Ta

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

ベストアンサー

SALINGER34549692009/12/06 17:23:45

コメント（3件)

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

トラックバック