人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

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

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

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

ケース2
第1土曜日の介助時間変更
16:30?19:00
21:00?23:30

ケース3
第2土曜日を変更
16:00?17:30
19:30?21:30
次の日の日曜日
21:30?23:00

ケース4
第3、第4土曜日を変更
16:30?18:30
20:30?23:00
次の日の日曜日
21:00?23:00

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


●質問者: kanachan
●カテゴリ:コンピュータ
✍キーワード:00 23 コード 土曜日 日曜日
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● SALINGER
●80ポイント ベストアンサー

記憶を頼りに修正してみます。

ケース4の3つ目はもともと無かったので介助の詳細は適当です。

コードのどの部分が第何週の何曜日かがわかるようにしておきましたので、

実際と違う部分は適宜修正してください。


第5土曜日の無い月の最終日曜(前回に有った条件)が、第3・4土曜日の翌日

(今回の条件)だった場合、時間が前後して表示するのは仕様です。


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日曜日があるかどうかを判別
 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
  '-----------------------------------------------------------------月曜1回目
 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
 
  '-----------------------------------------------------------------月曜2回目
 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
  '-----------------------------------------------------------------金曜1回目
 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
 
  '-----------------------------------------------------------------金曜2回目
 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
  '-----------------------------------------------------------------土曜第1週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
 
  '-----------------------------------------------------------------土曜第1週2回目
 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
  '-----------------------------------------------------------------土曜第2週1回目
 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
 
  '-----------------------------------------------------------------土曜第2週2回目
 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
 
  '-----------------------------------------------------------------土曜第2週の翌日
 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
  '-----------------------------------------------------------------土曜第3・4週1回目
 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
◎質問者からの返答

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

大体合ってるのですが、私の説明足らずすみません。

毎週土曜日の

13:00?15:00

の介助は残していただけますか?直そうとして失敗しました…

第3週、第4週のコードの続きってどうなるのでしょうか??

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ