【VBA】期間を指定してカレンダーを作成する

こんにちは、Ryoです。
集計などの処理を行う際に期間を指定した範囲でカレンダーを作成し、且つ祝日や土日の出勤なども反映してカスタマイズしたいケースが多々あるかと思います。今回、セルに範囲指定カレンダーを羅列する簡易的なものを作成してみましたので、その内容について書いていきます。

1.サンプル概要
2.サンプルコード
3.まとめ

1.サンプル概要

シート名を「設定Sheet」とし、そこに「開始年月日」「終了年月日」「会社休日」「土・日曜出勤日」の入力欄を設けています。

「開始年月日」は指定期間の開始日、「終了年月日」は指定期間の終了日になります。「会社休日」は主に祝日や勤務先で設定された休日など、「土・日曜出勤日」はそのままの意味です。

今回のサンプルでは指定した範囲を概ね1～3ヶ月を想定して作成しているので「会社休日」などの欄は10データ分としています。

上の例で実行すると、新規ブックに指定範囲の簡易的なカレンダーが出力されます。

以上がサンプル概要になります。

2.サンプルコード

Sub Sample1()

 Dim hlDay(1 To 10)
 Dim stcomDay(1 To 10)
 Dim i, n, hdCnt, stCnt As Integer
 Dim rDay, sDay, eDay, tgDay As Variant
 
 '画面固定化
 Application.ScreenUpdating = False
 '起動元ファイルの保存処理
 ActiveWorkbook.Save

 With Worksheets("設定Sheet")
     '開始年月日の読込
     eDay = .Cells(3, 4)
     '終了年月日の読込
     sDay = .Cells(3, 2)
 End With

 hdCnt = 0

'＊＊＊設定Sheetの「会社休日」を配列格納＊＊＊
 Range("A:D").Find(What:="「会社休日」").Select

 For i = 1 To 10
      ActiveCell.Offset(1, 0).Select
   If ActiveCell.Value <> "" Then
      hdCnt = hdCnt + 1
      hlDay(hdCnt) = ActiveCell.Value
   End If
 Next i
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

stCnt = 0

'＊＊＊設定sheetの「土・日曜出勤日」を配列格納＊＊＊
 Range("A:D").Find(What:="「土・日曜出勤日」").Select

  For i = 1 To 10
       ActiveCell.Offset(1, 0).Select
    If ActiveCell.Value <> "" Then
       stCnt = stCnt + 1
       stcomDay(stCnt) = ActiveCell.Value
    End If
  Next i
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

 '新規ブックを開く
 Workbooks.Add
 
 'セルA1,B1に見出し文字を記入
 Range("A1").Value = "「日付」"
 Range("B1").Value = "「Memo」"
 Cells.Font.Name = "メイリオ"
 Cells.Font.Size = "10.5"
 Range("A2").Select
 
  '「設定」で指定した開始日付のセル書込み
  ActiveCell = sDay
  
  'この表示形式で「西暦／月／日（曜日）」となる
  Selection.NumberFormatLocal = "yyyy/m/d(aaa)"
  '↑↑
  '＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
  '西暦表示不要の場合は以下のように記述
  'Selection.NumberFormatLocal = "m/d(aaa)"
  '＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
  
  '「設定」で指定した集計終了日
  tgDay = eDay
  rDay = sDay
  
  '開始日から1日ずつ足していき、アクティブセルが
  '終了日になった時点でループ終了
  Do Until ActiveCell = tgDay + 1
     '表示形式を合わせる
      Selection.NumberFormatLocal = "yyyy/m/d(aaa)"
     '↑↑
     '＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
     '西暦表示不要の場合は以下のように記述
     'Selection.NumberFormatLocal = "m/d(aaa)"
     '＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
     
     '土曜日、日曜日の判定
     'Weekday関数の定数
     '　1：日曜　2：月曜　3：火曜　4：水曜　5：木曜
     '　6：金曜　7：土曜
     
     '土日の場合はセルを黄色に塗りつぶし、文字色を赤
     Select Case Weekday(rDay)
       Case 1
         ActiveCell.Font.Color = RGB(255, 0, 0)
         ActiveCell.Interior.Color = RGB(255, 255, 0)
       Case 7
         ActiveCell.Font.Color = RGB(255, 0, 0)
         ActiveCell.Interior.Color = RGB(255, 255, 0)
     End Select
     
     '「設定」で記入した休日の検索と対処
     '対象日付は黄色塗りつぶし、赤文字
     If hdCnt <> 0 Then
        For n = 1 To hdCnt
         If rDay = hlDay(n) Then
           ActiveCell.Font.Color = RGB(255, 0, 0)
           ActiveCell.Interior.Color = RGB(255, 255, 0)
         End If
        Next n
     End If
      
      '「設定」で記入した土・日曜日出勤の検索と対処
      '上の処理で塗りつぶされた色を解除、文字色を黒
     If stCnt <> 0 Then
        For n = 1 To stCnt
         If rDay = stcomDay(n) Then
           ActiveCell.Font.Color = RGB(0, 0, 0)
           ActiveCell.Interior.ColorIndex = 0
         End If
        Next n
     End If
      
     rDay = ActiveCell.Value + 1
     '集計終了日付を超えたらLoop処理強制終了
     If rDay > tgDay Then Exit Do
     ActiveCell.Offset(1, 0).Select
     ActiveCell.Value = rDay
  Loop
 
  Columns("B").ColumnWidth = 40
  ActiveSheet.Range("A1").CurrentRegion. _
  Borders.LineStyle = xlContinuous
 
  With Range("A1:B1")
      'フォント太字設定
      .Font.Bold = True
      'セル色を灰色
      .Interior.Color = RGB(220, 220, 220)
  End With
   
  Range("B2").Select

End Sub

流れとしては起動元ファイル「設定Sheet」の開始～終了年月日、「会社休日」「土・日曜出勤日」のデータをそれぞれ読み込みます。

Findメソッドを利用して会社休日などの位置を探しているのは、サンプル作成の際に配置を変えたりしていた為なので、場所が決まっているのであれば特定セルを指定して処理を実行しても大丈夫です。

データの読み込みが完了したら、Workbooks.Addで新規ブックを開いて「日付」や「Memo」などの見出しを書き込みます。

◆「西暦／月／日（曜日）」の表示形式

後は開始日付から順次書き込んでいきますが、日付の表示形式で「西暦／月／日（曜日）」としたい場合は以下の形で指定します。

Selection.NumberFormatLocal = “yyyy/m/d(aaa)”

西暦が表示不要なら”m/d(aaa)”でOKです。

◆Weekday関数

土曜日や日曜日の判定についてはWeekday関数を利用して実行します。

構文：Weekday(date,firstdayofweek)

Weekday関数は日付を表すシリアル値から曜日を示す数値を取得するので、ここでは日曜日を示す「１」、土曜日を示す「７」をSelect Case文を使用して判定させています。

定数	値	内容
vbUseSystem	0	各国語対応(NLS)APIの設定値を使用
vbSunday	1	日曜（規定値）
vbMonday	2	月曜
vbTuesday	3	火曜
vbWednesday	4	水曜
vbThursday	5	木曜
vbFriday	6	金曜
vbSaturday	7	土曜