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


以前に上記質問させて頂いたのですが、またまた変更したい箇所が出てきました。
介助合計時間数(4列目?)を"1:00"等といった表示ではなく
=(D列-C列)*24
の計算式を入れて表示形式を「数値」小数点以下1までと死体です。
また、第二日曜日の
13:00~16:00 3.0 移動介助 みのり様 移動支援みのり様
として加えたいです。(行き先は未定)
現在のコードをコメントに表示しますので、どのように訂正したら良いか教えてください。
よろしくお願い致します。

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2010/02/28 16:25:59
  • 終了:2010/03/01 21:33:33

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/03/01 17:28:01

ポイント65pt

継ぎ足し継ぎ足しでわかりづらいコードになってしまいまして申し訳ありません。


① 5列目を数式に変更

元のコードの

Target.Offset(?, 4)

の行を全て数式を入れるように変更します。

(重複する場所は除いてコードを短くすることもできましたが、可読性を優先しました)


② 5列目の表示形式を変更。

最後の方で列ごと数値に変更しています。


③ 日曜第2週の追加。

もともと最終日曜以外は書き込まないようになっていました。

それで、第2週も書き込むようにコードを追加。

ただし、土曜の翌日に書き込む処理の後に日曜日が書き込まれるので、時間が前後する場合があります。


以下のコードで対応する番号が変更箇所です。(変更①は17箇所です)

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 Or Int((Day(myDate) - 1) / 7) + 1 = 2) 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
    
    
    '曜日で分岐
    Select Case Application.WorksheetFunction.Weekday(myDate)
        Case 1
            If Int((Day(myDate) - 1) / 7) + 1 = 2 Then
                '-----------------------------------------------------------------日曜第2週    変更③
                Target.Offset(0, 1).Value = "日"
                Target.Offset(0, 2).Value = "13:00"
                Target.Offset(0, 3).Value = "16:00"
                Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                Target.Offset(0, 5).Value = "移動介助"
                Target.Offset(0, 6).Value = "みのり様"
                Target.Offset(0, 9).Value = "移動支援"
                Target.Offset(0, 10).Value = "移動支援みのり様"
            Else
                '-----------------------------------------------------------------最終日曜
                Target.Offset(0, 1).Value = "日"
                Target.Offset(0, 2).Value = "14:00"
                Target.Offset(0, 3).Value = "19:00"
                Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"                     '変更①
                Target.Offset(0, 5).Value = "移動介助"
                Target.Offset(0, 6).Value = "みのり様"
                Target.Offset(0, 9).Value = "移動支援"
                Target.Offset(0, 10).Value = "移動支援みのり様"
            End If
        Case 2
            '-----------------------------------------------------------------月曜1回目
            Target.Offset(0, 1).Value = "月"
            Target.Offset(0, 2).Value = "20:00"
            Target.Offset(0, 3).Value = "20:30"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "移動介助"
            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 = "移動支援みのり様"
            
            
            '-----------------------------------------------------------------月曜2回目
            Target.Offset(1, 0).Value = Target.Value
            Target.Offset(1, 1).Value = "月"
            Target.Offset(1, 2).Value = "20:30"
            Target.Offset(1, 3).Value = "21:00"
            Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(1, 5).Value = "身体介護"
            Target.Offset(1, 6).Value = "みのり様"
            Target.Offset(1, 9).Value = "居宅介護"
            Target.Offset(1, 10).Value = "居宅介護みのり様"
            res = 2
        Case 3
            '-----------------------------------------------------------------火曜
            Target.Offset(0, 1).Value = "火"
            Target.Offset(0, 2).Value = "19:00"
            Target.Offset(0, 3).Value = "20:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "森田ケアーズ蔵前様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護森田ケアーズ蔵前様"
        Case 4
            '-----------------------------------------------------------------水曜
            Target.Offset(0, 1).Value = "水"
            Target.Offset(0, 2).Value = "19:30"
            Target.Offset(0, 3).Value = "20:30"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"
        Case 5
            '-----------------------------------------------------------------木曜
            Target.Offset(0, 1).Value = "木"
            Target.Offset(0, 2).Value = "19:15"
            Target.Offset(0, 3).Value = "20:15"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "支援センター様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護支援センター様"
        Case 6
            '-----------------------------------------------------------------金曜1回目
            Target.Offset(0, 1).Value = "金"
            Target.Offset(0, 2).Value = "18:30"
            Target.Offset(0, 3).Value = "20:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "移動介助"
            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 = "移動支援森田ケアーズ蔵前様"
            
            
            '-----------------------------------------------------------------金曜2回目
            Target.Offset(1, 0).Value = Target.Value
            Target.Offset(1, 1).Value = "金"
            Target.Offset(1, 2).Value = "22:00"
            Target.Offset(1, 3).Value = "23:30"
            Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(1, 5).Value = "移動介助"
            Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
            Target.Offset(1, 7).Value = "ジョナサン"
            Target.Offset(1, 8).Value = "徒歩"
            Target.Offset(1, 9).Value = "移動支援"
            Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
            res = 2
        Case 7
            '-----------------------------------------------------------------土曜共通1回目
            Target.Offset(0, 1).Value = "土"
            Target.Offset(0, 2).Value = "13:00"
            Target.Offset(0, 3).Value = "15:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"
            
            
            '第何週かで分岐
            Select Case Int((Day(myDate) - 1) / 7) + 1
                Case 1
                    '-----------------------------------------------------------------土曜第1週2回目
                    Target.Offset(1, 0).Value = Target.Value
                    Target.Offset(1, 1).Value = "土"
                    Target.Offset(1, 2).Value = "16:30"
                    Target.Offset(1, 3).Value = "19:00"
                    Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(1, 5).Value = "移動介助"
                    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 9).Value = "移動支援"
                    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    
                    '-----------------------------------------------------------------土曜第1週3回目
                    Target.Offset(2, 0).Value = Target.Value
                    Target.Offset(2, 1).Value = "土"
                    Target.Offset(2, 2).Value = "21:00"
                    Target.Offset(2, 3).Value = "23:30"
                    Target.Offset(2, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(2, 5).Value = "移動介助"
                    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(2, 9).Value = "移動支援"
                    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"
                    res = 3
                Case 2
                    '-----------------------------------------------------------------土曜第2週2回目
                    Target.Offset(1, 0).Value = Target.Value
                    Target.Offset(1, 1).Value = "土"
                    Target.Offset(1, 2).Value = "16:00"
                    Target.Offset(1, 3).Value = "17:30"
                    Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(1, 5).Value = "移動介助"
                    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 7).Value = "手話サークル"
                    Target.Offset(1, 8).Value = "日比谷線千代田線"
                    Target.Offset(1, 9).Value = "移動支援"
                    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    
                    '-----------------------------------------------------------------土曜第2週3回目
                    Target.Offset(2, 0).Value = Target.Value
                    Target.Offset(2, 1).Value = "土"
                    Target.Offset(2, 2).Value = "19:30"
                    Target.Offset(2, 3).Value = "21:30"
                    Target.Offset(2, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(2, 5).Value = "移動介助"
                    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(2, 7).Value = "手話サークル"
                    Target.Offset(2, 8).Value = "日比谷線千代田線"
                    Target.Offset(2, 9).Value = "移動支援"
                    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    '-----------------------------------------------------------------土曜第2週の翌日
                    Target.Offset(3, 0).Value = Target.Value + 1
                    Target.Offset(3, 1).Value = "日"
                    Target.Offset(3, 2).Value = "21:30"
                    Target.Offset(3, 3).Value = "23:00"
                    Target.Offset(3, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(3, 5).Value = "移動介助"
                    Target.Offset(3, 6).Value = "森田ケア
id:kanachan

ありがとうございます。

無事に出来ました!

コードの時はセルは「RC]を使うんですね。

細かい計算はまだまだ解らないんですがたすかりました。

ありがとうございます。

2010/03/01 21:31:29

その他の回答(1件)

id:km1967 No.1

km1967回答回数541ベストアンサー獲得回数402010/02/28 16:36:01

ポイント5pt

条件がよく分からない


表示形式を「数値」小数点以下1まで

整数部分の単位は何?

「時」それとも「分」?


=(D列-C列)*24

絶対にこの計算式を入れなければならないのか?

id:kanachan

えっとですね。

D列が介助終了時間、C列が介助開始時間です。

整数部は本来時、分両方あるのですが…例えば介助開始が15:30で終了時間が19:00だったら

19:00-15:30で介助時間が3時間30分となります。

でも普通に19:00-15:30と計算したら表示形式は「時間」になるので「3:30」となります。

それでも問題はないのですが、出来れば「3.5」と表示させたいんです。

それには

=(D列-C列)*24

の計算式は必要ですし、表示形式を「数値にして小数点以下1」にする必要があります。

これで宜しいでしょうか?

2010/02/28 20:08:48
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692010/03/01 17:28:01ここでベストアンサー

ポイント65pt

継ぎ足し継ぎ足しでわかりづらいコードになってしまいまして申し訳ありません。


① 5列目を数式に変更

元のコードの

Target.Offset(?, 4)

の行を全て数式を入れるように変更します。

(重複する場所は除いてコードを短くすることもできましたが、可読性を優先しました)


② 5列目の表示形式を変更。

最後の方で列ごと数値に変更しています。


③ 日曜第2週の追加。

もともと最終日曜以外は書き込まないようになっていました。

それで、第2週も書き込むようにコードを追加。

ただし、土曜の翌日に書き込む処理の後に日曜日が書き込まれるので、時間が前後する場合があります。


以下のコードで対応する番号が変更箇所です。(変更①は17箇所です)

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 Or Int((Day(myDate) - 1) / 7) + 1 = 2) 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
    
    
    '曜日で分岐
    Select Case Application.WorksheetFunction.Weekday(myDate)
        Case 1
            If Int((Day(myDate) - 1) / 7) + 1 = 2 Then
                '-----------------------------------------------------------------日曜第2週    変更③
                Target.Offset(0, 1).Value = "日"
                Target.Offset(0, 2).Value = "13:00"
                Target.Offset(0, 3).Value = "16:00"
                Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                Target.Offset(0, 5).Value = "移動介助"
                Target.Offset(0, 6).Value = "みのり様"
                Target.Offset(0, 9).Value = "移動支援"
                Target.Offset(0, 10).Value = "移動支援みのり様"
            Else
                '-----------------------------------------------------------------最終日曜
                Target.Offset(0, 1).Value = "日"
                Target.Offset(0, 2).Value = "14:00"
                Target.Offset(0, 3).Value = "19:00"
                Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"                     '変更①
                Target.Offset(0, 5).Value = "移動介助"
                Target.Offset(0, 6).Value = "みのり様"
                Target.Offset(0, 9).Value = "移動支援"
                Target.Offset(0, 10).Value = "移動支援みのり様"
            End If
        Case 2
            '-----------------------------------------------------------------月曜1回目
            Target.Offset(0, 1).Value = "月"
            Target.Offset(0, 2).Value = "20:00"
            Target.Offset(0, 3).Value = "20:30"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "移動介助"
            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 = "移動支援みのり様"
            
            
            '-----------------------------------------------------------------月曜2回目
            Target.Offset(1, 0).Value = Target.Value
            Target.Offset(1, 1).Value = "月"
            Target.Offset(1, 2).Value = "20:30"
            Target.Offset(1, 3).Value = "21:00"
            Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(1, 5).Value = "身体介護"
            Target.Offset(1, 6).Value = "みのり様"
            Target.Offset(1, 9).Value = "居宅介護"
            Target.Offset(1, 10).Value = "居宅介護みのり様"
            res = 2
        Case 3
            '-----------------------------------------------------------------火曜
            Target.Offset(0, 1).Value = "火"
            Target.Offset(0, 2).Value = "19:00"
            Target.Offset(0, 3).Value = "20:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "森田ケアーズ蔵前様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護森田ケアーズ蔵前様"
        Case 4
            '-----------------------------------------------------------------水曜
            Target.Offset(0, 1).Value = "水"
            Target.Offset(0, 2).Value = "19:30"
            Target.Offset(0, 3).Value = "20:30"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"
        Case 5
            '-----------------------------------------------------------------木曜
            Target.Offset(0, 1).Value = "木"
            Target.Offset(0, 2).Value = "19:15"
            Target.Offset(0, 3).Value = "20:15"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "支援センター様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護支援センター様"
        Case 6
            '-----------------------------------------------------------------金曜1回目
            Target.Offset(0, 1).Value = "金"
            Target.Offset(0, 2).Value = "18:30"
            Target.Offset(0, 3).Value = "20:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "移動介助"
            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 = "移動支援森田ケアーズ蔵前様"
            
            
            '-----------------------------------------------------------------金曜2回目
            Target.Offset(1, 0).Value = Target.Value
            Target.Offset(1, 1).Value = "金"
            Target.Offset(1, 2).Value = "22:00"
            Target.Offset(1, 3).Value = "23:30"
            Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(1, 5).Value = "移動介助"
            Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
            Target.Offset(1, 7).Value = "ジョナサン"
            Target.Offset(1, 8).Value = "徒歩"
            Target.Offset(1, 9).Value = "移動支援"
            Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
            res = 2
        Case 7
            '-----------------------------------------------------------------土曜共通1回目
            Target.Offset(0, 1).Value = "土"
            Target.Offset(0, 2).Value = "13:00"
            Target.Offset(0, 3).Value = "15:00"
            Target.Offset(0, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
            Target.Offset(0, 5).Value = "身体介護"
            Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
            Target.Offset(0, 9).Value = "居宅介護"
            Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"
            
            
            '第何週かで分岐
            Select Case Int((Day(myDate) - 1) / 7) + 1
                Case 1
                    '-----------------------------------------------------------------土曜第1週2回目
                    Target.Offset(1, 0).Value = Target.Value
                    Target.Offset(1, 1).Value = "土"
                    Target.Offset(1, 2).Value = "16:30"
                    Target.Offset(1, 3).Value = "19:00"
                    Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(1, 5).Value = "移動介助"
                    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 9).Value = "移動支援"
                    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    
                    '-----------------------------------------------------------------土曜第1週3回目
                    Target.Offset(2, 0).Value = Target.Value
                    Target.Offset(2, 1).Value = "土"
                    Target.Offset(2, 2).Value = "21:00"
                    Target.Offset(2, 3).Value = "23:30"
                    Target.Offset(2, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(2, 5).Value = "移動介助"
                    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(2, 9).Value = "移動支援"
                    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"
                    res = 3
                Case 2
                    '-----------------------------------------------------------------土曜第2週2回目
                    Target.Offset(1, 0).Value = Target.Value
                    Target.Offset(1, 1).Value = "土"
                    Target.Offset(1, 2).Value = "16:00"
                    Target.Offset(1, 3).Value = "17:30"
                    Target.Offset(1, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(1, 5).Value = "移動介助"
                    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(1, 7).Value = "手話サークル"
                    Target.Offset(1, 8).Value = "日比谷線千代田線"
                    Target.Offset(1, 9).Value = "移動支援"
                    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    
                    '-----------------------------------------------------------------土曜第2週3回目
                    Target.Offset(2, 0).Value = Target.Value
                    Target.Offset(2, 1).Value = "土"
                    Target.Offset(2, 2).Value = "19:30"
                    Target.Offset(2, 3).Value = "21:30"
                    Target.Offset(2, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(2, 5).Value = "移動介助"
                    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
                    Target.Offset(2, 7).Value = "手話サークル"
                    Target.Offset(2, 8).Value = "日比谷線千代田線"
                    Target.Offset(2, 9).Value = "移動支援"
                    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"
                    
                    
                    '-----------------------------------------------------------------土曜第2週の翌日
                    Target.Offset(3, 0).Value = Target.Value + 1
                    Target.Offset(3, 1).Value = "日"
                    Target.Offset(3, 2).Value = "21:30"
                    Target.Offset(3, 3).Value = "23:00"
                    Target.Offset(3, 4).FormulaR1C1 = "=(RC[-1]-RC[-2])*24"
                    Target.Offset(3, 5).Value = "移動介助"
                    Target.Offset(3, 6).Value = "森田ケア
id:kanachan

ありがとうございます。

無事に出来ました!

コードの時はセルは「RC]を使うんですね。

細かい計算はまだまだ解らないんですがたすかりました。

ありがとうございます。

2010/03/01 21:31:29
  • id:kanachan
    現在のコードを載せさせていただきます。
    変更を教えてください。

    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


    '曜日で分岐
    Select Case Application.WorksheetFunction.Weekday(myDate)
    Case 1
    '-----------------------------------------------------------------最終日曜
    Target.Offset(0, 1).Value = "日"
    Target.Offset(0, 2).Value = "14:00"
    Target.Offset(0, 3).Value = "19:00"
    Target.Offset(0, 4).Value = "5:00"
    Target.Offset(0, 5).Value = "移動介助"
    Target.Offset(0, 6).Value = "みのり様"
    Target.Offset(0, 9).Value = "移動支援"
    Target.Offset(0, 10).Value = "移動支援みのり様"
    Case 2
    '-----------------------------------------------------------------月曜1回目
    Target.Offset(0, 1).Value = "月"
    Target.Offset(0, 2).Value = "20:00"
    Target.Offset(0, 3).Value = "20:30"
    Target.Offset(0, 4).Value = "0:30"
    Target.Offset(0, 5).Value = "移動介助"
    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 = "移動支援みのり様"


    '-----------------------------------------------------------------月曜2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "月"
    Target.Offset(1, 2).Value = "20:30"
    Target.Offset(1, 3).Value = "21:00"
    Target.Offset(1, 4).Value = "0:30"
    Target.Offset(1, 5).Value = "身体介護"
    Target.Offset(1, 6).Value = "みのり様"
    Target.Offset(1, 9).Value = "居宅介護"
    Target.Offset(1, 10).Value = "居宅介護みのり様"
    res = 2
    Case 3
    '-----------------------------------------------------------------火曜
    Target.Offset(0, 1).Value = "火"
    Target.Offset(0, 2).Value = "19:00"
    Target.Offset(0, 3).Value = "20:00"
    Target.Offset(0, 4).Value = "1:00"
    Target.Offset(0, 5).Value = "身体介護"
    Target.Offset(0, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(0, 9).Value = "居宅介護"
    Target.Offset(0, 10).Value = "居宅介護森田ケアーズ蔵前様"
    Case 4
    '-----------------------------------------------------------------水曜
    Target.Offset(0, 1).Value = "水"
    Target.Offset(0, 2).Value = "19:30"
    Target.Offset(0, 3).Value = "20:30"
    Target.Offset(0, 4).Value = "1:00"
    Target.Offset(0, 5).Value = "身体介護"
    Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
    Target.Offset(0, 9).Value = "居宅介護"
    Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"
    Case 5
    '-----------------------------------------------------------------木曜
    Target.Offset(0, 1).Value = "木"
    Target.Offset(0, 2).Value = "19:15"
    Target.Offset(0, 3).Value = "20:15"
    Target.Offset(0, 4).Value = "1:00"
    Target.Offset(0, 5).Value = "身体介護"
    Target.Offset(0, 6).Value = "支援センター様"
    Target.Offset(0, 9).Value = "居宅介護"
    Target.Offset(0, 10).Value = "居宅介護支援センター様"
    Case 6
    '-----------------------------------------------------------------金曜1回目
    Target.Offset(0, 1).Value = "金"
    Target.Offset(0, 2).Value = "18:30"
    Target.Offset(0, 3).Value = "20:00"
    Target.Offset(0, 4).Value = "1:30"
    Target.Offset(0, 5).Value = "移動介助"
    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 = "移動支援森田ケアーズ蔵前様"


    '-----------------------------------------------------------------金曜2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "金"
    Target.Offset(1, 2).Value = "22:00"
    Target.Offset(1, 3).Value = "23:30"
    Target.Offset(1, 4).Value = "1:30"
    Target.Offset(1, 5).Value = "移動介助"
    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(1, 7).Value = "ジョナサン"
    Target.Offset(1, 8).Value = "徒歩"
    Target.Offset(1, 9).Value = "移動支援"
    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"
    res = 2
    Case 7
    '-----------------------------------------------------------------土曜第共通1回目
    Target.Offset(0, 1).Value = "土"
    Target.Offset(0, 2).Value = "13:00"
    Target.Offset(0, 3).Value = "15:00"
    Target.Offset(0, 4).Value = "2:00"
    Target.Offset(0, 5).Value = "身体介護"
    Target.Offset(0, 6).Value = "あやの実ヘルパーステーション様"
    Target.Offset(0, 9).Value = "居宅介護"
    Target.Offset(0, 10).Value = "居宅介護あやの実ヘルパーステーション様"


    '第何週かで分岐
    Select Case Int((Day(myDate) - 1) / 7) + 1
    Case 1
    '-----------------------------------------------------------------土曜第1週2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "土"
    Target.Offset(1, 2).Value = "16:30"
    Target.Offset(1, 3).Value = "19:00"
    Target.Offset(1, 4).Value = "2:30"
    Target.Offset(1, 5).Value = "移動介助"
    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(1, 9).Value = "移動支援"
    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"



    '-----------------------------------------------------------------土曜第1週3回目
    Target.Offset(2, 0).Value = Target.Value
    Target.Offset(2, 1).Value = "土"
    Target.Offset(2, 2).Value = "21:00"
    Target.Offset(2, 3).Value = "23:30"
    Target.Offset(2, 4).Value = "2:30"
    Target.Offset(2, 5).Value = "移動介助"
    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(2, 9).Value = "移動支援"
    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"
    res = 3
    Case 2
    '-----------------------------------------------------------------土曜第2週2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "土"
    Target.Offset(1, 2).Value = "16:00"
    Target.Offset(1, 3).Value = "17:30"
    Target.Offset(1, 4).Value = "1:30"
    Target.Offset(1, 5).Value = "移動介助"
    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(1, 7).Value = "手話サークル"
    Target.Offset(1, 8).Value = "日比谷線千代田線"
    Target.Offset(1, 9).Value = "移動支援"
    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"



    '-----------------------------------------------------------------土曜第2週3回目
    Target.Offset(2, 0).Value = Target.Value
    Target.Offset(2, 1).Value = "土"
    Target.Offset(2, 2).Value = "19:30"
    Target.Offset(2, 3).Value = "21:30"
    Target.Offset(2, 4).Value = "2:00"
    Target.Offset(2, 5).Value = "移動介助"
    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(2, 7).Value = "手話サークル"
    Target.Offset(2, 8).Value = "日比谷線千代田線"
    Target.Offset(2, 9).Value = "移動支援"
    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"


    '-----------------------------------------------------------------土曜第2週の翌日
    Target.Offset(3, 0).Value = Target.Value + 1
    Target.Offset(3, 1).Value = "日"
    Target.Offset(3, 2).Value = "21:30"
    Target.Offset(3, 3).Value = "23:00"
    Target.Offset(3, 4).Value = "1:30"
    Target.Offset(3, 5).Value = "移動介助"
    Target.Offset(3, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(3, 9).Value = "移動支援"
    Target.Offset(3, 10).Value = "移動支援森田ケアーズ蔵前様"
    res = 4
    Case 3, 4
    '-----------------------------------------------------------------土曜第3・4週2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "土"
    Target.Offset(1, 2).Value = "16:30"
    Target.Offset(1, 3).Value = "18:30"
    Target.Offset(1, 4).Value = "2:00"
    Target.Offset(1, 5).Value = "移動介助"
    Target.Offset(1, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(1, 9).Value = "移動支援"
    Target.Offset(1, 10).Value = "移動支援森田ケアーズ蔵前様"


    '-----------------------------------------------------------------土曜第3・4週3回目
    Target.Offset(2, 0).Value = Target.Value
    Target.Offset(2, 1).Value = "土"
    Target.Offset(2, 2).Value = "20:30"
    Target.Offset(2, 3).Value = "23:00"
    Target.Offset(2, 4).Value = "2:30"
    Target.Offset(2, 5).Value = "移動介助"
    Target.Offset(2, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(2, 9).Value = "移動支援"
    Target.Offset(2, 10).Value = "移動支援森田ケアーズ蔵前様"



    '-----------------------------------------------------------------土曜第3・4週の翌日
    Target.Offset(3, 0).Value = Target.Value + 1
    Target.Offset(3, 1).Value = "日"
    Target.Offset(3, 2).Value = "21:00"
    Target.Offset(3, 3).Value = "23:00"
    Target.Offset(3, 4).Value = "2:00"
    Target.Offset(3, 5).Value = "移動介助"
    Target.Offset(3, 6).Value = "森田ケアーズ蔵前様"
    Target.Offset(3, 9).Value = "移動支援"
    Target.Offset(3, 10).Value = "移動支援森田ケアーズ蔵前様"
    res = 4
    Case 5
    '-----------------------------------------------------------------土曜第5週2回目
    Target.Offset(1, 0).Value = Target.Value
    Target.Offset(1, 1).Value = "土"
    Target.Offset(1, 2).Value = "16:30"
    Target.Offset(1, 3).Value = "21:30"
    Target.Offset(1, 4).Value = "5:00"
    Target.Offset(1, 5).Value = "移動介助"
    Target.Offset(1, 6).Value = "みのり様"
    Target.Offset(1, 9).Value = "移動支援"
    Target.Offset(1, 10).Value = "移動支援みのり様"

    '第5土曜だけは前行を上書き
    Target.Offset(0, 6).Value = "みのり様"
    res = 2
    End Select
    End Select

    myMacro = res

    End Function
  • id:SALINGER
    時間があれば修正させていただきます。
  • id:kanachan
    SALINGER 様
    いつもありがとうございます。
    自分でも頑張ってみてるのですがうまくいきませんで…
    今月中に解れば間に合いますので時間はあります。
    是非是非お願いします。
  • id:SALINGER
    やっぱり途中で切れましたか。
    ブログの方に全文アップしました。
    http://d.hatena.ne.jp/SALINGER/20100301

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

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

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

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