VBAでのシフト表の何日～何日までの求め方

Question

同じ質問がありましたら申し訳ございません。
VBAに興味を持ち、関数より楽しく色々勉強している身なのですが、どなたかお力をお貸し下さい。

VBAでシフト表を作る際に、D3セルが「15」でAI3セルが「16」日までの日付を入力するにはどの様にプログラムを組めばよろしいのでしょうか？
例えばD3セルに2017/03/15と入力し横に自動で表示出来る様にしたいのです。 
その際に月の28日、30日、31日の空いているセルが、動いた分削除される、シフト表を作成したいのです。
また日付の下のセルには関連付けで曜日を表示させたいです。
重ね、VBAでのシフト表を作る際に参考にした書籍などありましたらお教え下さい。

どうぞよろしくお願い致します。

tatsu99 · Accepted Answer

No11です。＞D2のセルから右へ祝日の日を表示させたいのですが可能でしょうか？反映しました。カレンダー作成のマクロに組み込みました。添付の図のように設定シートのC列に祝日名を記入しておく必要があります。＞またD8セルから右へその日の合計人数を。最後にそのD8セルの合計人数が3人の日に背景を赤になる表示をさせたいのです。反映しました。勤務日数集計のマクロに組み込みました。以下のようになります。前回のマクロを全て破棄し、こちらで入れ替えてください。 ---------------------------------------- Option Explicit 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("D2:AH" & maxrow1 + 1).Value = "" '祝日名／日／曜日 sh1.Range("D3:AH" & maxrow1 + 1).Interior.Pattern = xlNone '日／曜日の背景色 sh1.Range("AJ5:AJ" & maxrow1).Value = "" 'AJの勤務日数合計 'カレンダー作成 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 '祝日判定 Private Function IsHoliday(ByVal wdate As Date, ByVal sh0 As Worksheet, ByVal maxrow0 As Long) As Long Dim row As Long IsHoliday = 0 For row = 2 To maxrow0 If sh0.Cells(row, "B").Value = wdate Then IsHoliday = row Exit Function End If Next End Function Public Sub 勤務日数集計() Dim sh1 As Worksheet 'シフト表シート Dim col As Long '列 Dim i As Long Dim workcount As Long '勤務日数 Dim maxrow1 As Long Dim row As Long Set sh1 = Worksheets("シフト表") maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得 '勤務日数集計 For row = 5 To maxrow1 workcount = 0 For i = 0 To 30 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, "AJ").Value = workcount Next 'その日の合計人数 For i = 0 To 30 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 '3人が出勤の場合（全員が出勤の場合） 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 · Answer

>tatsu99さん、最後に１つだけ質問させていただきます。
>D3セルから右に日付が表示された際に、その書式をユーザー定義の「d」の「16」等の数字で表示をさせたいのですがどの様>に記述すればよろしいですか？
回答：
No16に書いておきました。そちらを参照ください。

tatsu99 · Answer

>D3セルから右に日付が表示された際に、その書式をユーザー定義の「d」の「16」等の数字で表示をさせたいのですがどの様>に記述すればよろしいですか？

'カレンダークリア
sh1.Range("D2:AH" & maxrow1 + 1).Value = "" '祝日名／日／曜日
sh1.Range("D3:AH" & maxrow1 + 1).Interior.Pattern = xlNone '日／曜日の背景色
sh1.Range("AJ5:AJ" & maxrow1).Value = "" 'AJの勤務日数合計

に
    sh1.Range("D3:AH3").NumberFormatLocal = "d"                       '書式設定
を追加してください。

tatsu99 · Answer

>「その日の出勤人数が3名の時に背景を赤」と記述しておりますが正しくは3名以下、が赤色になります。
>'3人が出勤の場合(全員が出勤の場合の)のIf workcount = maxrow1 - 6 + 1 Then
>sh1.Cells(maxrow1 + 1, col).Interior.color = 255 '赤色、の部分を変更するのでしょうか？
回答：
はい。
If workcount = maxrow1 - 5 + 1 Then
を
If workcount < maxrow1 - 5 + 1 Then
に変えてください。

WindFaller · Answer

>2017/03/15と入力し横に自動で表示出来る様にしたいのです。 
という言葉に従って、イベント型のマクロを書いたのですが、他の方で同様のマクロも見逃したのは、まだVBAは不慣れのようにお見受けしました。

以下、一応、イベント型マクロを、標準プロシージャに戻しました。
シートの指定はありませんから、お好きなシートへどうぞ。別に邪魔にはならないだろうと思います。

Range("D3")が、出発点ですから、そこに日にちを入れてください。
stDate とは、「スタートの日付」という意味です。
休日データはマクロ自体の中に封入されていますので、そのまま使えます。
2018/4/30 より以降は、休日リストを書き換えなくてはなりません。
このマクロは、単独で、休日も含めています。

'//新しい標準モジュールで、天辺から貼り付けてください。
Private Const s_HOLIDAY As String = "2017/02/11,2017/03/20,2017/04/29,2017/05/03,2017/05/04,2017/05/05,2017/07/17,2017/08/11,2017/09/18,2017/09/23,2017/10/09,2017/11/03,2017/11/23,2017/12/23,2018/01/01,2018/01/08,2018/02/11,2018/02/12,2018/03/21,2018/04/29,2018/04/30"
Sub Listing_Date_Week()
　Dim aryHoliday As Variant
　Dim mDate As Date
　Dim nDate As Date
　Dim stDate As Range
　Dim dif As Long, hld As Variant
　Dim i As Long
　　
　Set stDate = Range("D3")
　mDate = stDate
　
　If stDate.Value = "" Then
　　MsgBox "D3の値が空です", vbExclamation
　　 Range("D3").Select
　　Exit Sub
　End If
　aryHoliday = Split(s_HOLIDAY, ",")　'*
　
　'1ヶ月とは:Month(mDate) + 1
　nDate = DateSerial(Year(mDate), Month(mDate) + 1, Day(mDate - 1))
　dif = nDate - mDate
　With stDate.Offset(, 1).Resize(2, dif - 1)
　　 .ClearContents
　　 .ClearFormats
　End With
　For i = 0 To dif
　 With stDate.Offset(, i)
　　　.Value = mDate + i
　　　.NumberFormatLocal = "d"
　　　.Resize(2).HorizontalAlignment = xlCenter
　　　.Offset(1).Value = Format$(stDate + i, "aaa")
　　　
　　　hld = ""
　　　hld = Application.Match(Format$(stDate + i, "yyyy/mm/dd"), aryHoliday, 0)　'**
　　　If IsNumeric(hld) Then
　　　 .Resize(2).Font.ColorIndex = 45　'祭日-黄色->43
　　　ElseIf Weekday(stDate + i) = 7 Then
　　　　.Resize(2).Font.ColorIndex = 8 '土曜日-水色
　　　ElseIf Weekday(stDate + i) = 1 Then
　　　　.Resize(2).Font.ColorIndex = 3 '日曜日-赤
　　　End If
　 End With
　Next i
End Sub

tatsu99 · Answer

No11です。画像の添付を忘れました。

tatsu99 · Answer

No1です。最終的にはユーザーフォームで開始日を指定したいということなので、暫定的に添付図のようにしました。 "設定"シートのA2に開始日を設定しておく。（添付図青色） "設定"シートのB2以降に祝日を設定しておく。（添付図黄色）１）上記の設定を参照しカレンダーを作成するマクロ（カレンダー作成）を提供する。 "シフト表"シートのD3～AH3へ日付 "シフト表"シートのD4～AH4へ曜日を設定する。但し、2月16日開始の場合は、AE列（28日）までしか設定せず、AD～AH列は空白を設定する。土曜日は水色、日曜日は赤色、祝日には黄色を設定する。（水色＝青色になるかもしれませんが）祝日と土曜日又は日曜日が重なった場合は、祝日の色を設定する。２）カレンダー作成後、勤務日数をカウントするマクロ（勤務日数集計）を提供する。勤務日数は、”休”の文字がなければ、出勤としてカウントする。 2月の場合は、AE列までしか検索しないので、AD～AHに”休”を入れておく必要はない。集計結果はAJ列に表示する。（AI列は使用されることはない）以下のマクロを標準モジュールへ設定してください。 ----------------------------------------------------- Option Explicit 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 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:AH" & maxrow1).Value = "" '日／曜日 sh1.Range("D3:AH4").Interior.Pattern = xlNone '日／曜日の背景色 sh1.Range("AJ5:AJ" & maxrow1).Value = "" 'AJの勤務日数合計 'カレンダー作成 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 If IsHoliday(wdate, sh0, maxrow0) = True Then color = 65535 '黄色 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 '祝日判定 Private Function IsHoliday(ByVal wdate As Date, ByVal sh0 As Worksheet, ByVal maxrow0 As Long) As Boolean Dim row As Long IsHoliday = False For row = 2 To maxrow0 If sh0.Cells(row, "B").Value = wdate Then IsHoliday = True Exit Function End If Next End Function Public Sub 勤務日数集計() Dim sh1 As Worksheet 'シフト表シート Dim col As Long '列 Dim i As Long Dim workcount As Long '勤務日数 Dim maxrow1 As Long Dim row As Long Set sh1 = Worksheets("シフト表") maxrow1 = sh1.Cells(Rows.Count, "C").End(xlUp).row 'シフト表 C列の最大行取得 '勤務日数集計 For row = 5 To maxrow1 workcount = 0 For i = 0 To 30 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, "AJ").Value = workcount Next MsgBox ("完了") End Sub ------------------------------------------------------------ 設定のシートに開始日、祝日が設定されてないとエラーになります。シフト表のシートがないとエラーになります。

WindFaller · Answer

VBAはExcel 表計算とは、違うアプリだと思ってもよいと思います。

>VBAでのシフト表を作る際に参考にした書籍
私の経験では、シフト表はマクロでは作らないのではないかと思います。自分がシフト表は、VBAでは、ことごとく実用化には至らなかった、いえ、全滅だったからです。私は、全体的な把握が欠如していたのかもしれませんが、何年やっても、思ったものは出来上がりません。たかが、カレンダーさえ四苦八苦している状態です。やっと出来上がったのは、万年型の休日算定プログラムでした。

>VBAに興味を持ち、関数より楽しく色々勉強している身
VBAを好きな人は、縁台将棋のように、楽しんでいる人も多いようです。Excel VBAは作って終わりではなくて、その後も、実用に使えるからいいのです。
わからなければ、ベテランに聞くというわけですが、ベテランにも二色あって、Excel VBAが最初で、そこからずっとVBAのままの人と、いろんな修行を積んで戻ってきている人とがあります。

さて、前置きが長すぎました。
>今月の16日～来月の15日まで
という部分で、2017/3/15 でしたら、2017/4/14 まで　出力するようにできています。

黄色の色だけは、ご自身で書き換えください。私のところでは、黄色などですと、はっきり見えなくなる関係で、色を変えさせていただきました。

なお、意味の取り違えに関しては、直せる範囲で直します。

'//シートモジュール　(シートタブ右クリック--コードの表示)
Private Const s_HOLIDAY As String = "2017/02/11,2017/03/20,2017/04/29,2017/05/03,2017/05/04,2017/05/05,2017/07/17,2017/08/11,2017/09/18,2017/09/23,2017/10/09,2017/11/03,2017/11/23,2017/12/23,2018/01/01,2018/01/08,2018/02/11,2018/02/12,2018/03/21,2018/04/29,2018/04/30"

Private Sub Worksheet_Change(ByVal Target As Range)
　Dim aryHoliday As Variant
　Dim mDate As Date
　Dim nDate As Date
　Dim stDate As Range
　Dim dif As Long, hld As Variant
　Dim i As Long
　
　If Target.Address <> "$D$3" Then Exit Sub
　mDate = Target.Value
　Set stDate = Target
　If Target.Value = "" Then Exit Sub
　If Not IsDate(Target.Value) Then Exit Sub
　aryHoliday = Split(s_HOLIDAY, ",")
　
　'予め右端は決めさせていただきました。 1ヶ月:Month(mDate) + 1
　nDate = DateSerial(Year(mDate), Month(mDate) + 1, Day(mDate - 1))
　dif = nDate - mDate
　With Target.Offset(, 1).Resize(2, dif - 1)
　Application.EnableEvents = False
　　 .ClearContents
　　 .ClearFormats
　 Application.EnableEvents = True
　End With
　For i = 0 To dif
　 With stDate.Offset(, i)
　　　Application.EnableEvents = False
　　　.Value = mDate + i
　　　.NumberFormatLocal = "d"
　　　.Resize(2).HorizontalAlignment = xlCenter

.Offset(1).Value = Format$(stDate + i, "aaa")
　　　Application.EnableEvents = True
　　　
　　　hld = ""
　　　hld = Application.Match(Format$(stDate + i, "yyyy/mm/dd"), aryHoliday, 0)
　　　If IsNumeric(hld) Then
　　　 .Resize(2).Font.ColorIndex = 45　'祭日-黄色->43
　　　ElseIf Weekday(stDate + i) = 7 Then
　　　　.Resize(2).Font.ColorIndex = 8 '土曜日-水色
　　　ElseIf Weekday(stDate + i) = 1 Then
　　　　.Resize(2).Font.ColorIndex = 3 '日曜日-赤
　　　End If
　 End With
　Next i
End Sub

yokomaya · Answer

＞COUNTIFの計算もvbaで出来るのでしょうか？

頭で出来ることは概ね出来るのがvba

標準モジュールに

Function 出勤カウント(開始日付 As Date, セル範囲 As Range)
    Dim CL As Range, Edate As Date
    
    Edate = 開始日付 + 30
    Edate = DateSerial(Year(Edate), Month(Edate), 1) - 1
    
    For Each CL In セル範囲.Resize(1, Day(Edate))
        If CL <> "休" Then 出勤カウント = 出勤カウント + 1
    Next
End Function

動作の考え方はexcelの時とほぼ同様。

AJ5には
=出勤カウント(E$3,E5:AI5)
とすればvbaでユーザー関数として計算できます。

（日本語使うのは賛否あると思うけど注釈減らせるから僕は好き）

yokomaya · Answer

おおきく外れてましたね。でも基本は変わらない。大の月、小の月、VBAなしでも同じで済ませられるのがexcelのいいところ。ただ確認が２点＞今月の16日～来月の15日までのとなっているのにどうして D3にシフトの開始日の2017/3/15日と入力？＞=COUNTIF(E5:AI5,"<>休") これも２個目ということは何のためのＤ列？まあそれでもe3にd3+1で右にオートフィルされていたら上のCOUNTIFは =COUNTIF(OFFSET(E5,0,0,1,DAY(DATE(YEAR($AG$3),MONTH($AG$3),1)-1)),"<>休") （AG3は当然月替わりしているはずのセル座標だからその年月の１日目の前日の日付、逆に言えば前月の最終日こそがほしい数の28,30,31にあたる。それを範囲指定に使える OFFSET()に応用するとこうなりました）これで大小の月は自動調整されるはず、うるう年の29も自動だから絶対こっちが有利と思うよ。条件付き書式は曜日の色付けもお手の物。最初にAG3:AI４を選択して条件付き書式で数式を使用して書式設定するセルを決定を選び数式には =DAY(AG$3)>DAY($D$3) 書式はフォントの色で白色を選びます。（罫線もこの式で同様に判定できるから表の横幅を自動調整も可能です）次にD3:AI4を選択して条件付き書式は数式を使用して書式設定するセルを決定を選び =WEEKDAY(D$3)=1 で赤を選ぶそのままもう一度条件付き書式で数式を使用して書式設定するセルを決定を選び =WEEKDAY(D$3)=7 で水色だね。 VBAはEXCELで出来ないいろんなことが可能で、便利だけど生産効率は良くはないから、excelだけで実現できることに使うよりも本当にexcelできないことだけに絞るほうが仕事だったら妥当じゃないかな。そういう意味では祝日だけがexcelでは出来ない。これをネット検索して使うのは良いと思います。

VBAでのシフト表の何日～何日までの求め方

No11です。

>tatsu99さん、最後に１つだけ質問させていただきます。

>D3セルから右に日付が表示された際に、その書式をユーザー定義の「d」の「16」等の数字で表示をさせたいのですがどの様>に記述すればよろしいですか？

>「その日の出勤人数が3名の時に背景を赤」と記述しておりますが正しくは3名以下、が赤色になります。

>2017/03/15と入力し横に自動で表示出来る様にしたいのです。

No11です。

No1です。

VBAはExcel 表計算とは、違うアプリだと思ってもよいと思います。

＞COUNTIFの計算もvbaで出来るのでしょうか？

おおきく外れてましたね。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング