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

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列…居宅介護

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

●質問者: kanachan
●カテゴリ:コンピュータ
✍キーワード:00 CD みのり コメント コード
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●105ポイント

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


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

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
◎質問者からの返答

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

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

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

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

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

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

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

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

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

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


2 ● SALINGER
●105ポイント ベストアンサー

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

||<

◎質問者からの返答

すみません。

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

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

なぜでしょう?

関連質問


●質問をもっと探す●



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