特定曜日の特定セルを書式設定したいです。

質問

月間予定表を複数作っております。

＜状況＞
A1 ： ドロップダウンリストで年度を指定
D1 ： ドロップダウンリストで月を指定
A3 ： =date(A1,D1,1) 毎月1日を表示
A4 ： =A3+1 毎月2日を表示
A5 ： =A4+1 毎月3日を表示
・　　　
・　　　A列を毎月末まで作成しています。

＜やりたい事＞
原本シート作ろうとしており、それをCOPYし、そのシートを翌月へ更新した時に・・・
毎金曜日　：　J列～O列（13時～16時）を図の様に書式設定したい
毎日曜日　：　A列～O列（9時～16時）を図の様に書式設定したい

書式設定
　文字入力 ⇒ 第〇会議室　・　時間　
　セルの結合と文字列を中央に
　背景をグレーに

マクロ、VBAになるのでしょうか・・・。
月を切り替えて日付・曜日を更新し、条件付き書式で色を付ける所までは
できました。しかし、そこからができませんでした。
テキストボックスにマクロを登録してボタンを設置し、押した時に処理される様な
形式にしていただければと思っております。　金曜日ボタン・日曜日ボタンと
二つに分かれても構いません。

どうか宜しくお願いします。　同様の処理のシートが複数あり、困ってきました。
皆様のお力貸して頂けませんでしょうか。お願いします。

回答No.2

keithin · ベストアンサー

シート名タブを右クリックしてコードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

private sub Worksheet_Change(byval Target as excel.range)
　dim r as integer
　dim d as date
　if application.intersect(target, range("A1,D1")) is nothing then exit sub
　if range("A1") = "" or range("D1") = "" then exit sub

　range("B3:O33").unmerge
　range("B3:O33").clearcontents
　range("B3:O33").wraptext = true
　range("B3:O33").horizontalalignment = xlcenter
　range("B3:O33").interior.colorindex = xlnone

　application.enableevents = false
　for r = 3 to 33
　　d = dateserial(range("A1"), range("D1"), r - 2)
　　if month(d) = range("D1") then
　　　select case format(d, "aaa")
　　　case "金"
　　　　range(cells(r, "J"), cells(r, "O")).merge
　　　　cells(r, "J") = "第一会議室" & vblf & "13:00～16:00"
　　　　cells(r, "J").interior.color = xlgray25
　　　case "日"
　　　　range(cells(r, "B"), cells(r, "O")).merge
　　　　cells(r, "B") = "第二会議室" & vblf & "9:00～16:00"
　　　　cells(r, "B").interior.color = xlgray25
　　　case else
　　　end select
　　end if
　next r
　application.enableevents = true
end sub

ファイルメニューから終了してエクセルに戻る
Ａ１、Ｄ１をてきとーに書き換えると自動で動作する。

＃塗色については好みに応じて修正してください。

＃オマケ
Ａ３セルには
=IF(MONTH(DATE($A$1,$D$1,ROW(A1)))=$D$1,DATE($A$1,$D$1,ROW(A1)),"")
と記入、セルの書式設定のユーザー定義で d(aaa)と設定
３１日のセルまでコピー貼り付ける

回答No.3

tom04

No.1です！
たびたびごめんなさい。
前回のコードで間違いが２ヶ所ありました。

＞If WorksheetFunction.Weekday(Cells(i, "A")) = 1 Then
を
＞If WorksheetFunction.Weekday(Cells(i, "A")) = 6 Then
に

＞ElseIf WorksheetFunction.Weekday(Cells(i, "A")) = 5 Then
を
＞ElseIf WorksheetFunction.Weekday(Cells(i, "A")) = 1 Then
に
訂正してください。

曜日と列範囲が違っていました。m（_ _）m

回答No.1

tom04

こんばんは！

＞テキストボックスにマクロを登録してボタンを設置し、押した時に・・・
とありますので、テキストボックスを挿入　→　上下左右の小さな矢印になるところで右クリック　→　マクロの登録
→　編集　→　VBE画面に↓のコードをコピー＆ペーストしてみてください。

Sub テキストボックス1_Click()
Dim i As Long
i = Cells(Rows.Count, "A").End(xlUp).Row
With Range(Cells(3, "B"), Cells(i, "O"))
.ClearContents
.UnMerge
.Interior.ColorIndex = xlNone
End With
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.Weekday(Cells(i, "A")) = 1 Then
With Range(Cells(i, "J"), Cells(i, "O"))
.Merge
.Interior.ColorIndex = 15 '←グレイ25％
.Value = "第一会議室" & vbCrLf & "13:00～16：00"
.HorizontalAlignment = xlCenter
End With
ElseIf WorksheetFunction.Weekday(Cells(i, "A")) = 5 Then
With Range(Cells(i, "B"), Cells(i, "O"))
.Merge
.Interior.ColorIndex = 15
.Value = "第二会議室" & vbCrLf & "9：00～16：00"
.HorizontalAlignment = xlCenter
End With
End If
Next i
End Sub

1行目の
＞Sub テキストボックス1_Click()
と最終行の
＞End Sub
は表示されますのでその間に2行目以降をコピー＆ペーストします。

※　各行は2行分表示されるだけの高さが十分あるものとします。
こんな感じではどうでしょうか？m（_ _）m