VBAで作成する勤務表の合計を求めるセルの月によるズレに対応したプログラムについて

3月2日に「VBAでのシフト表の何日～何日までの求め方」を投稿した者です。
シフト表を作成した際にAJのセルに合計数値が求められるのですが月の28、30、31日に合わせ、その合計セルがずれる様になるVBAプログラムを作成したいのですが可能なのでしょうか？

例えばカレンダーはDセルから始まり、2月は15日がAFまでのセルとします。その横のAGのセルに合計値を。
4月は15日がAHまでであり、AIに合計値を。
5月はこの15日がAIまでであり、このご質問通りAJセルで合計値が出力されます。
その月に合わせ合計値のセルが動いてくれると嬉しいものと思ったのでご質問させていただきました。

私のご説明が分かりずらいかと思いますがよろしくお願い致します。

No.4 ベストアンサー 回答者： tatsu99 回答日時： 2017/04/12 06:31

前回提示したPublic Sub カレンダー作成()のプロシージャを以下のマクロで置き換えてください。

----------------------------------------------------
Public Sub カレンダー作成()
Dim sh0 As Worksheet '設定シート
Dim sh1 As Worksheet 'シフト表シート
Dim s_date As Date '開始日
Dim e_date As Date '終了日
Dim col As Long '列
Dim wkday As Long '曜日（1:日～7:土）
Dim wdate As Date
Dim i As Long
Dim maxrow0 As Long
Dim maxrow1 As Long
Dim row0 As Long
Dim color As Long '日付・曜日の背景色
Set sh0 = Worksheets("設定")
Set sh1 = Worksheets("シフト表")
'開始日取得
s_date = sh0.Cells(2, "A").Value
'終了日計算
e_date = DateAdd("m", 1, s_date) - 1
maxrow0 = sh0.Cells(Rows.Count, "B").End(xlUp).row '設定 B列の最大行取得
maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得
'カレンダークリア
sh1.Range("D3:AH3").NumberFormatLocal = "d" '書式設定
sh1.Range("D2:AK" & maxrow1 + 1).Value = "" '祝日名／日／曜日
sh1.Range("D3:AH" & maxrow1 + 1).Interior.Pattern = xlNone '日／曜日の背景色
sh1.Range("AJ5:AJ" & maxrow1).Value = "" 'AJの勤務日数合計
sh1.Range("AG5:AK" & maxrow1).Borders.LineStyle = xlLineStyleNone '罫線クリア
sh1.Cells(3, e_date - s_date + 6).Value = "チェック欄"
sh1.Cells(3, e_date - s_date + 7).Value = "合計"
'罫線
sh1.Range(sh1.Cells(5, e_date - s_date + 6), sh1.Cells(maxrow1, e_date - s_date + 7)).Borders.LineStyle = True
'カレンダー作成
For i = 0 To (e_date - s_date)
col = 4 + i
wdate = s_date + i
wkday = Weekday(wdate)
sh1.Cells(3, col).Value = wdate '日付
sh1.Cells(4, col).Value = WeekdayName(wkday, True) '曜日
'土曜日は水色、日曜日は赤色、祝日には黄色を背景に設定する
'休日判定（祝日と土日が重なった場合は祝日優先）
color = -1
row0 = IsHoliday(wdate, sh0, maxrow0)
If row0 > 0 Then
'祝日の場合
color = 65535 '黄色
sh1.Cells(2, col).Value = sh0.Cells(row0, "C").Value '祝日名
Else
If wkday = 1 Then color = 255 '赤
If wkday = 7 Then color = 15773696 '水色
End If
If color <> -1 Then
sh1.Cells(3, col).Interior.color = color
sh1.Cells(4, col).Interior.color = color
End If
Next
MsgBox ("完了")
End Sub
----------------------------------------------

この回答へのお礼

ありがとうございます！
出来ました！

作成している中で色々とやりたい事が増えてしまい申し訳ございません。
「チェック欄」の文字を縦書きにしたいのですがOrientation = xlVerticalをどの様に記述すればよろしいのでしょうか？
またsh1.Cells(3, e_date - s_date + 6).Value = "チェック欄"
sh1.Cells(3, e_date - s_date + 7).Value = "合計"
の下に、「チェック欄」と「合計」のセルを結合し、横にずれるセル結合のプログラムを組み込みたいのですがどの様になりますでしょうか？
Range("AG3:AG4").Merge、Range("AH3:AH4").Mergeで
結合させるコードは分かったのですが月に合わせ結合をクリアし、新しく結合させる様にしたいのです。
重ねて'罫線
sh1.Range(sh1.Cells(3, e_date - s_date + 5), sh1.Cells(maxrow1, e_date - s_date + 6)).Borders.LineStyle = True
が物凄い便利でCセルからAGまでを罫線で囲みたいのですがどの様にプログラムを組めばよろしいのか教えて下さい。
Cセルに担当者名が入力させているセルにだけ罫線が引かれるとは驚きです。

よろしくお願い致します。

お礼日時：2017/04/13 14:05

No.3 回答者： tatsu99 回答日時： 2017/04/11 23:48

No2です。

図を添付するのを忘れました。
4月のケースです。

No.2 回答者： tatsu99 回答日時： 2017/04/11 23:33

>また重ねて、あと二点程ご質問させていただきます。

>このそれぞれの月に合わせ合計値セルがずれる様に出来た所の、上のセルに「合計」という文字を入力したいのが一点。
>次に4月のシフトを例に、AさんBさんCさんがいるとします。
>最終曜日15日の右のセル、AI3セルに「チェック欄」の文字を記述し、その下AI5セルからAI7セルにそれぞれ罫線で囲み、>>チェック欄を作りたいのです。
>そして、その右AJ3セルに「合計」の文字を出力しAJ5セルからAJ7セルに合計値を求め、罫線で囲みたい内容になります。
>これらも月が変わると同時に同じくずれる様に出来るのでしょうか？

添付図の黄色部分のようにしたいということでしょうか。（添付図は４月のケースです）
そうであれば、前回提示した
Public Sub カレンダー作成()のマクロの修正になります。
また、今回、No1で提示したマクロは、合計をAI列に出力（4月のケース）しています。それをAJ列に出力するように変える必要があります。
まず、Public Sub 勤務日数集計()のマクロの
-------------------------------
'勤務日数集計
For row = 5 To maxrow1
workcount = 0
For i = 0 To (e_date - s_date)
col = 4 + i
If sh1.Cells(3, col).Value <> "" And sh1.Cells(row, col).Value <> "休" Then
workcount = workcount + 1
End If
Next
sh1.Cells(row, e_date - s_date + 7).Value = workcount '①
Next
-----------------------------------
①の部分を修正していただけますか。そうすると、1列右側に出力するようになります。

この回答へのお礼

添付画像ありがとうございます！
この様にしたいのです！
sh1.Cells(row, e_date - s_date + 6).Value = workcountの「+6」を「+ 7」に変更しすればよろしいのですね！
目標の添付画像の様にする為にはどの様にプログラムを構築すればよろしいのでしょうか？

よろしくお願い致します。

お礼日時：2017/04/12 02:10

No.1 回答者： tatsu99 回答日時： 2017/04/10 14:04

前回、回答したものです。

Public Sub 勤務日数集計()を以下のマクロで全て置き換えてください。
---------------------------------------
Public Sub 勤務日数集計()
Dim sh0 As Worksheet '設定シート
Dim sh1 As Worksheet 'シフト表シート
Dim s_date As Date '開始日
Dim e_date As Date '終了日
Dim col As Long '列
Dim i As Long
Dim workcount As Long '勤務日数
Dim maxrow1 As Long
Dim row As Long
Set sh0 = Worksheets("設定")
Set sh1 = Worksheets("シフト表")
'開始日取得
s_date = sh0.Cells(2, "A").Value
'終了日計算
e_date = DateAdd("m", 1, s_date) - 1
maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得
'勤務日数集計
For row = 5 To maxrow1
workcount = 0
For i = 0 To (e_date - s_date)
col = 4 + i
If sh1.Cells(3, col).Value <> "" And sh1.Cells(row, col).Value <> "休" Then
workcount = workcount + 1
End If
Next
sh1.Cells(row, e_date - s_date + 6).Value = workcount
Next
'その日の合計人数
For i = 0 To (e_date - s_date)
col = 4 + i
If sh1.Cells(3, col).Value = "" Then Exit For
workcount = 0
For row = 5 To maxrow1
If sh1.Cells(row, col).Value <> "休" Then
workcount = workcount + 1
End If
Next
sh1.Cells(maxrow1 + 1, col).Value = workcount
'出勤人数が３人未満の場合（全員が出勤しない場合）
sh1.Cells(maxrow1 + 1, col).Interior.Pattern = xlNone
If workcount < maxrow1 - 5 + 1 Then
sh1.Cells(maxrow1 + 1, col).Interior.color = 255 '赤色
End If
Next
MsgBox ("完了")

End Sub
----------------------------------------

この回答へのお礼

tatsu99さんお早いご回答ありがとうございます！
こんな事まで出来るのですね！
tatsu99さんがよろしければ、このプログラムにおける詳細なご説明をしていただけると嬉しいのですが、よろしくお願い致します。

また重ねて、あと二点程ご質問させていただきます。
このそれぞれの月に合わせ合計値セルがずれる様に出来た所の、上のセルに「合計」という文字を入力したいのが一点。
次に4月のシフトを例に、AさんBさんCさんがいるとします。
最終曜日15日の右のセル、AI3セルに「チェック欄」の文字を記述し、その下AI5セルからAI7セルにそれぞれ罫線で囲み、チェック欄を作りたいのです。
そして、その右AJ3セルに「合計」の文字を出力しAJ5セルからAJ7セルに合計値を求め、罫線で囲みたい内容になります。
これらも月が変わると同時に同じくずれる様に出来るのでしょうか？

よろしくお願い致します。

お礼日時：2017/04/11 16:32