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


上記質問の答えを元にコードを修正しました。
(修正コードはコメント記入できたら表示します)
今度は月曜日を下記のように分けるにはどのようにしたら良いでしょうか?
ケース1
CD列(結合して中央揃えしてます)…20:00
E列…20:30
F列…E列-CD列
G列…移動介助
H列…みのり様
I列…家
J列…⇔
K列…レンタルショップ
L列…徒歩
M列…移動支援

ケース2
CD列…20:30
E列…21:00
F列…E列-CD列
G列…身体介護
H列…みのり様
I~L列…空欄
M列…居宅介護

お手数ですが教えてください。

回答の条件
  • 1人2回まで
  • 登録:2009/09/08 13:20:06
  • 終了:2009/09/10 22:46:42

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/09/09 19:42:58

ポイント105pt

A列に日付を入力して(例えばA4)入力したセルを選択状態で、「表の作成」という名前のマクロを実行すると

その下にその日からその月の分の表を自動的に作成するマクロにしてみました。

そのため、前回の質問にあった4番の→と⇔を入れたら変更されるという部分は品雑になるので省きました。

その部分は作成後手動で変更すればいいと思います。


今回のマクロは前回のマクロと違って、実行させて機能するものです。

それで前回のマクロは削除し、前回とは違う標準モジュールにコピペしてください。

方法と実行方法はこちらを参考にしてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


>|vb|

Sub 表の作成()

Dim myDate As Date

Dim myDate2 As Date

Dim myMonth As String

Dim i As Integer

Dim check As Boolean

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

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 = 4) 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 res As Integer

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, 2).Value = "16:30"

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, 5

Target.Offset(1, 4).Value = "21:30"

Target.Offset(1, 5).Value = "5:00"

Case 2

Target.Offset(1, 4).Value = "17:30"

Target.Offset(1, 5).Value = "1:00"

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, 4).Value = "23:00"

Target.Offset(1, 5).Value = "6:30"

End Select

End Select

myMacro = res

End Function

||<

id:kanachan

すみません。

ご説明いただいたとおり行なっているはず…なのですが「コンパイルエラー:行番号または…(中略)が間違っています」と表示され、

の部分が赤くなっています。何か間違った操作したのかもしれないのですが、標準モジュールに貼り付けて票の実行を行なってみて数回にわたり失敗してます。

なぜでしょう?

2009/09/10 09:38:23

その他の回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/09/08 16:26:43

ポイント105pt

コメントが少なく、なかなか作った本人以外わかりづらいコードですいません。


いろいろと修正されたようですね。

VBAがわかるようなので、説明しながら作ってみたいと思います。

まず、D列は結合して無くなっているので、コート中のOffset(0, 3)の行はいらなくなります。

そして、行を追加したときにC列とD列を結合するようなコードを追加します。

更に、データの列がM列まであるので日付が変更されたときに前のデータが残らないようにします。


ここからが、今回の質問の修正

曜日で分岐の2のところがお察しのように月曜日のところになります。

ここに土曜日のときのように行を追加するコードを追加します。

修正したコード全文は以下。


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim mydate As Date
    
    If Target.Column = 10 And Cells(Target.Row, "B").Value = "土" Then
        If Target.Value = "→" Or Target.Value = "⇔" Or Target.Value = "" Then
            Application.EnableEvents = False
            If Cells(Target.Row, "A").Value <> "" And _
                Cells(Target.Row, "A").Value = Cells(Target.Row + 1, "A").Value Then
                Rows(Target.Row + 1).Delete
            End If
            If Cells(Target.Row, "A").Value <> "" And _
                Cells(Target.Row, "A").Value = Cells(Target.Row + 1, "A").Value Then
                Rows(Target.Row + 1).Delete
            End If
            Application.EnableEvents = True
            Cells(Target.Row, "A").Value = Cells(Target.Row, "A").Value
        Else
            Exit Sub
        End If
    Else
        If Target.Column <> 1 Then Exit Sub
    
        If IsDate(Target.Value) Then
            mydate = Target.Value
        Else
            Exit Sub
        End If
        
        
        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 = "移動支援"
            
                Application.EnableEvents = False
                If Target.Value <> Target.Offset(1, 0).Value Then
                    Rows(Target.Row + 1).Insert
                    Range(Target.Offset(1, 2), Target.Offset(1, 3)).Merge
                    Target.Offset(1, 2).HorizontalAlignment = xlCenter
                    Target.Offset(1, 0).Value = Target.Value
                Else
                    Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 13)).ClearContents
                End If
                Application.EnableEvents = True
                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 = "居宅介護"
            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 = "居宅介護"
                
                Application.EnableEvents = False
                If Target.Value <> Target.Offset(1, 0).Value Then
                    Rows(Target.Row + 1).Insert
                    Range(Target.Offset(1, 2), Target.Offset(1, 3)).Merge
                    Target.Offset(1, 2).HorizontalAlignment = xlCenter
                    Target.Offset(1, 0).Value = Target.Value
                Else
                    Range(Cells(Target.Row + 1, 2), Cells(Target.Row + 1, 13)).ClearContents
                End If
                Application.EnableEvents = True
                Target.Offset(1, 1).Value = "土"
                Target.Offset(1, 2).Value = "16:30"
                Target.Offset(1, 6).Value = "移動介助"
                Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"
                
                '第何週かで分岐
                Select Case Int((Day(mydate) - 1) / 7) + 1
                    Case 1, 5
                        Target.Offset(1, 4).Value = "21:30"
                        Target.Offset(1, 5).Value = "5:00"
                        Target.Offset(1, 6).Value = "移動介助"
                    Case 2
                        'J列で分岐
                        If Target.Offset(0, 9).Value = "⇔" Then
                            Target.Offset(1, 4).Value = "23:00"
                            Target.Offset(1, 5).Value = "6:30"
                        Else
                            Target.Offset(1, 4).Value = "17:30"
                            Target.Offset(1, 5).Value = "1:00"
                            Application.EnableEvents = False
                            If Target.Value <> Target.Offset(2, 0).Value Then
                                Rows(Target.Row + 2).Insert
                                Range(Target.Offset(2, 2), Target.Offset(2, 3)).Merge
                                Target.Offset(2, 2).HorizontalAlignment = xlCenter
                                Target.Offset(2, 0).Value = Target.Value
                            Else
                                Range(Cells(Target.Row + 2, 2), Cells(Target.Row + 2, 13)).ClearContents
                            End If
                            Application.EnableEvents = True
                            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 = "移動支援"
                        End If
                    Case 3
                        'J列で分岐
                        If Target.Offset(0, 9).Value = "→" Then
                            Target.Offset(1, 4).Value = "17:30"
                            Target.Offset(1, 5).Value = "1:00"
                            Target.Offset(1, 6).Value = "移動介助"
                            Application.EnableEvents = False
                            If Target.Value <> Target.Offset(2, 0).Value Then
                                Rows(Target.Row + 2).Insert
                                Range(Target.Offset(2, 2), Target.Offset(2, 3)).Merge
                                Target.Offset(2, 2).HorizontalAlignment = xlCenter
                                Target.Offset(2, 0).Value = Target.Value
                            Else
                                Range(Cells(Target.Row + 2, 2), Cells(Target.Row + 2, 13)).ClearContents
                            End If
                            Application.EnableEvents = True
                            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 = "移動支援"
                        Else
                            Target.Offset(1, 4).Value = "23:00"
                            Target.Offset(1, 5).Value = "6:30"
                        End If
                    Case 4
                        Target.Offset(1, 4).Value = "23:00"
                        Target.Offset(1, 5).Value = "6:30"
                End Select
        End Select
    End If
    
End Sub
id:kanachan

ありがとうございます。助かりました。

VBAはさっぱり解らないんです。

最近やっとコードの文字を大きくする方法が解りまして(奇跡的に発見したのでもう一度出来るかどうか…)

今回はじっくりコードを見てみました。

何となく「Target」の後の番号?が列番号にあたるのかな?と考えまして始まりの列、今回ならB列が1番目で私の持っているデータはM列まであるから最後の列(M列)は12番までになるのかな?といじってみたら出来たんです。

因みにセルの場所によって介助開始時間(CD列)の時間が中央そろえになったり、M列の文字が表示されないのはなぜでしょうか?

分岐のところでそういった現象が起きているようなのですが…

また、行き先がハッキリしている部分は記入されるようにしていますが、(家、手話サークル、松が谷福祉会館など)そうでないものと言いますか確定していない部分は空欄にしておいて跡で決まったら入れようと思っているのですが、入れたい場合には別のコードも必要なのでしょうか?

最後の質問に関しましては別の質問、となりますのでお応えいただきましたら70ポイント追加させていただきます。

VBA、すごく楽ですね。少しずつ勉強していきたいと思います。今まで文字を大きく出来なかった分見えなくてあきらめていました。

2009/09/08 17:15:56
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/09/09 19:42:58ここでベストアンサー

ポイント105pt

A列に日付を入力して(例えばA4)入力したセルを選択状態で、「表の作成」という名前のマクロを実行すると

その下にその日からその月の分の表を自動的に作成するマクロにしてみました。

そのため、前回の質問にあった4番の→と⇔を入れたら変更されるという部分は品雑になるので省きました。

その部分は作成後手動で変更すればいいと思います。


今回のマクロは前回のマクロと違って、実行させて機能するものです。

それで前回のマクロは削除し、前回とは違う標準モジュールにコピペしてください。

方法と実行方法はこちらを参考にしてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


>|vb|

Sub 表の作成()

Dim myDate As Date

Dim myDate2 As Date

Dim myMonth As String

Dim i As Integer

Dim check As Boolean

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

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 = 4) 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 res As Integer

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, 2).Value = "16:30"

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, 5

Target.Offset(1, 4).Value = "21:30"

Target.Offset(1, 5).Value = "5:00"

Case 2

Target.Offset(1, 4).Value = "17:30"

Target.Offset(1, 5).Value = "1:00"

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, 4).Value = "23:00"

Target.Offset(1, 5).Value = "6:30"

End Select

End Select

myMacro = res

End Function

||<

id:kanachan

すみません。

ご説明いただいたとおり行なっているはず…なのですが「コンパイルエラー:行番号または…(中略)が間違っています」と表示され、

の部分が赤くなっています。何か間違った操作したのかもしれないのですが、標準モジュールに貼り付けて票の実行を行なってみて数回にわたり失敗してます。

なぜでしょう?

2009/09/10 09:38:23
  • id:kanachan
    修正したコードです。

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim mydate As Date

    If Target.Column = 10 And Cells(Target.Row, "B").Value = "土曜日" Then
    If Target.Value = "→" Or Target.Value = "⇔" Or Target.Value = "" Then
    Application.EnableEvents = False
    If Cells(Target.Row, "A").Value <> "" And _
    Cells(Target.Row, "A").Value = Cells(Target.Row + 1, "A").Value Then
    Rows(Target.Row + 1).Delete
    End If
    If Cells(Target.Row, "A").Value <> "" And _
    Cells(Target.Row, "A").Value = Cells(Target.Row + 1, "A").Value Then
    Rows(Target.Row + 1).Delete
    End If
    Application.EnableEvents = True
    Cells(Target.Row, "A").Value = Cells(Target.Row, "A").Value
    Else
    Exit Sub
    End If
    Else
    If Target.Column <> 1 Then Exit Sub

    If IsDate(Target.Value) Then
    mydate = Target.Value
    Else
    Exit Sub
    End If

    '曜日で分岐
    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 = "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, 3).Value = "20:00"
    Target.Offset(0, 4).Value = "21:00"
    Target.Offset(0, 5).Value = "1:00"
    Target.Offset(0, 6).Value = "身体介護"
    Target.Offset(0, 7).Value = "みのり様"
    Target.Offset(0, 12).Value = "居宅介護"
    Case 3
    Target.Offset(0, 1).Value = "火"
    Target.Offset(0, 2).Value = "18:30"
    Target.Offset(0, 3).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, 3).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, 3).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, 3).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, 3).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 = "居宅介護"

    Application.EnableEvents = False
    If Target.Value <> Target.Offset(1, 0).Value Then
    Rows(Target.Row + 1).Insert
    Target.Offset(1, 0).Value = Target.Value
    End If
    Application.EnableEvents = True
    Target.Offset(1, 1).Value = "土"
    Target.Offset(1, 2).Value = "16:30"
    Target.Offset(0, 3).Value = "16:30"
    Target.Offset(1, 6).Value = "移動介助"
    Target.Offset(1, 7).Value = "森田ケアーズ蔵前様"

    '第何週かで分岐
    Select Case Int((Day(mydate) - 1) / 7) + 1
    Case 1, 5
    Target.Offset(1, 4).Value = "21:30"
    Target.Offset(1, 5).Value = "5:00"
    Target.Offset(1, 6).Value = "移動介助"
    Case 2
    'J列で分岐
    If Target.Offset(0, 9).Value = "⇔" Then
    Target.Offset(1, 4).Value = "23:00"
    Target.Offset(1, 5).Value = "6:30"
    Else
    Target.Offset(1, 4).Value = "17:30"
    Target.Offset(1, 5).Value = "1:00"
    Application.EnableEvents = False
    If Target.Value <> Target.Offset(2, 0).Value Then
    Rows(Target.Row + 2).Insert
    Target.Offset(2, 0).Value = Target.Value
    End If
    Application.EnableEvents = True
    Target.Offset(2, 1).Value = "土"
    Target.Offset(2, 2).Value = "19:30"
    Target.Offset(2, 3).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 = "移動支援"
    End If
    Case 3
    'J列で分岐
    If Target.Offset(0, 9).Value = "→" Then
    Target.Offset(1, 4).Value = "17:30"
    Target.Offset(1, 5).Value = "1:00"
    Target.Offset(1, 6).Value = "移動介助"
    Application.EnableEvents = False
    If Target.Value <> Target.Offset(2, 0).Value Then
    Rows(Target.Row + 2).Insert
    Target.Offset(2, 0).Value = Target.Value
    End If
    Application.EnableEvents = True
    Target.Offset(2, 1).Value = "土"
    Target.Offset(2, 2).Value = "19:30"
    Target.Offset(2, 3).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 = "移動支援"

    Else
    Target.Offset(1, 4).Value = "23:00"
    Target.Offset(1, 5).Value = "6:30"
    End If
    Case 4
    Target.Offset(1, 4).Value = "23:00"
    Target.Offset(1, 5).Value = "6:30"
    End Select
    End Select
    End If

    End Sub
  • id:SALINGER
    Targetは変更のあった日付のセルを意味します。
    その後のoffsetで、そこから下に何個目、右に何個目のセルという意味です。
    介助開始時間(CD列)は質問文から既に結合されていて中央揃えになっているのかなと思ったので
    新たに追加される行では自動的に結合して中央揃えになるようにしました。
    M列が表示されないのは、土曜日の2列目になると思います。
    これはコメント欄のコードで抜けていた部分でして、
    >>
    '第何週かで分岐
    <<
    という部分の直前に
    >>
    Target.Offset(1, 12).Value = "移動支援"
    <<
    のように入れればいいです。
    確定してる部分はコード中で同じように、自動で入るようにして、
    不確定の部分は直接セルに入力するのがいいと思います。
    日付とJ列の→や⇔を変更すると実行されるマクロなので、A列以外は自由に編集することができます。
  • id:kanachan
    す…すみません。
    →や⇔を入れると行が増えて行き先?(家とか手話サークルの入っている列)が忽然と消えます…
    例えば、第1土曜日の介助16:30~21:30の介助には行き先は記入されていません。
    それでコードに
    Target.Offset(1, 6).Value = "移動介助"
    Target.Offset(1, 8).Value = "家"
    Target.Offset(1, 9).Value = "⇔"
    と入れますと延々行が増えて13:00~15:00の介助が100行は並んでいるような…
    これは土曜日だから起こるのでしょうか?
    土曜日であっても行き先が決まっていなかったら後から入力していきたいんですね。
    直に矢印を入力しますと行き先を先に入力しても消えてしまいます。

    If Target.Column = 10 And Cells(Target.Row, "B").Value = "土" Then
    If Target.Value = "→" Or Target.Value = "⇔" Or Target.Value = "" Then
    Application.EnableEvents = False
    If Cells(Target.Row, "A").Value <> "" And _
    Cells(Target.Row, "A").Value = Cells(Target.Row + 1, "A").Value Then
    Rows(Target.Row + 1).Delete
    End If

    のコードのどこかを直すのかな?と思ったのですが…
    一体どうしたらよいのでしょうか?
  • id:SALINGER
    すいません。私のコードのミスです。
    前の質問にあった4番の機能で→や⇔を後から入れたときに変更されるようにつけ加えたコードなんです。
    この機能は品雑なるので無いほうがいいような気がするので、お時間をいただければ修正したものを回答します。
  • id:kanachan
    是非御願いします!
    出来れば日付も自動的に入力されるようにしてもらえると助かります。
    マクロの作れない私は関数で以下の式を立ててました。

    =IF(OR(B4=2,B4=3,B4=4,B4=5,B4=6),A4+1,IF(B2=6,A2+3,IF(B1=6,A1+4,IF(DATE(YEAR($A$1),MONTH($A$1),1)+7-WEEKDAY(DATE(YEAR($A$1),MONTH($A$1),1),2)+7,A4,IF(DATE(YEAR($A$1),MONTH($A$1),1)+14-WEEKDAY(DATE(YEAR($A$1),MONTH($A$1),1),2)+7,A4,A4+1)))))

    この時は曜日をweekday関数で出していましたので
    日曜=1
    土曜=7
    としています。
    A4のセルには当月最初の介助日を手入力で、9月や10月は1日、11月は2日を入れてます。
    11月が2日から始まるのは日曜日だったからです。

    ポイント、モチロン更に加算させていただきます。
  • id:SALINGER
    前回の質問からの続きになりますが、
    日曜日なのですが、基本的に介助は無くて、第5土曜日が無いときだけ、第4日曜日があるということになりますでしょうか。
  • id:kanachan
    すみません。
    エラー部分貼り付けたはずが上手くいきませんでした
    >|vb|


    ||<

    です。
  • id:SALINGER
    それは、はてなでたまにある、記法のバグです。
    「>|vb|」と「||<」で囲むと、最初の回答のように色分けされて見やすいコードになるのですが、
    たまにはてなでうまく処理してくれなくて上記のようになります。
    「>|vb|」と「||<」の内側が実際のコードになります。
  • id:SALINGER
    それで、2の回答のコメントでは、
    >|vb|

    ||<
    と書いたので「と」だけが色分けされて表示されたと思います。
    回答欄と回答のコメントでは、はてな記法が適用されるのです。
  • id:SALINGER
    ブログのほうに同じものをアップしましたので、こちらをコピーすれば見やすいです。
    http://d.hatena.ne.jp/SALINGER/20090910
  • id:kanachan
    SALINGER 様

    ありがとうございます。無事に出来ました。
    まだまだ教えていただくこと宅差なると思いますが今回もすごく助けられて嬉しいです。
    VBA、ちょっとずつでも理解できるように頑張ってみます、

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

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

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

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