1. Home » 
2. Excel VBA入門：目次 » 
3. 年間カレンダーを作成する

年間カレンダーを作成する:Excel VBA入門

スポンサードリンク

年間カレンダーを作成する(その1)　　　topへ

• 月間カレンダーをベースにしていますので、月間カレンダーを作成する　も参照してください。
• 年を指定して1年分のカレンダーを作成してみます。下図は1月〜3月の部分です。
  • 下図の2011/1/3は「指定休日」としていますので、通常のカレンダーとは異なっています。
    後述の「祝日(指定休日)リスト」によって判定していますことを付記しておきます。
  
• 祝日(指定休日)はL2以降に書き出しておきます。必要な年の分すべてを入力しておきます。
  • 【例】チェックに使用するのはL列の値ですので、M,N列は無くても構いませんが、間違いがあった時は見つけやすいので書いておきます。
    
• コードの作成例です。2011/2/26にコードを修正しました。
  • 【例】データは配列に入れてシートへ書き出すようにしています。
    • 月間カレンダーとほとんど同じです。細かな部分は月間カレンダーを作成するを参照してください。
    • 1月〜12月をFor i = 1 To 12　〜Next　でループしてシートに書き出しています。
      そのため配列myTableはその都度設定しクリアしています。
    • 10行おきに書き出すためにmyRow = 10　とし　myRow * (i - 1)　のように計算しています。
      myRow = 10　の10の部分を書き換えることで間隔を変えることができます。
    • 1904年日付システムでは不具合がありましたのでコードを修正しました。(2011/5/12)
      • [XL] 1900 年から計算する日付システムと 1904 年から計算する日付システム
        http://support.microsoft.com/kb/180162/ja

    Sub calendar_year() 　　Dim myDate As Integer 　　Dim Nen As Integer, Tuki As Integer 　　Dim i As Integer, j As Long, k As Integer 　　Dim cn As Long 　　Dim myTitleD, myTitle(1 To 1, 1 To 7) 　　Dim myRow 　　Dim c As Range 　　　　myRow = 10 　　　　'作成する年を入力します 　　　　myDate = Application.InputBox(Title:="年の指定", _ 　　　　　　　　　　　　　　　　Prompt:="作成する年を入力してください", _ 　　　　　　　　　　　　　　　　Default:="2011", Type:=1) 　　　　Nen = myDate 　　　　'曜日を配列にセットします 　　　　myTitleD = Array("日", "月", "火", "水", "木", "金", "土") 　　　　For k = 0 To 6 　　　　　　myTitle(1, k + 1) = myTitleD(k) 　　　　Next k 　　　　'ひと月の日付を配列にセットします 　　　　Range("A:H").Clear 　　　　Application.ScreenUpdating = False 　　　　For i = 1 To 12 　　　　　　Dim myTable(1 To 6, 1 To 7) 　　　　　　cn = 1 　　　　　　For j = DateSerial(Nen, i, 1) To DateSerial(Nen, i + 1, 0) 　　　　　　　　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 1 　　　　　　　　　　myTable(cn, Weekday(j)) = Format(j, "yyyy/m/d") 　　　　　　Next j 　　　　　　'シートに書き出します 　　　　　　Range("A" & 1 + myRow * (i - 1)).Value = DateSerial(Nen, i, 1) 　　　　　　Range("B" & 2 + myRow * (i - 1)).Resize(1, 7).Value = myTitle 　　　　　　Range("B" & 3 + myRow * (i - 1)).Resize(6, 7).Value = myTable 　　　　　　'書式を設定します 　　　　　　Range("A" & 1 + myRow * (i - 1)).NumberFormatLocal = "yyyy""年""m""月""" 　　　　　　Range("B" & 2 + myRow * (i - 1)).Resize(7, 7).HorizontalAlignment = xlCenter 　　　　　　Range("B" & 3 + myRow * (i - 1)).Resize(6, 7).NumberFormatLocal = "d" 　　　　　　'日曜日は赤色にします 　　　　　　Range("B" & 3 + 10 * (i - 1)).Resize(6, 1).Font.Color = RGB(255, 0, 0) 　　　　　　'土曜日は青色にします 　　　　　　Range("H" & 3 + 10 * (i - 1)).Resize(6, 1).Font.Color = RGB(0, 0, 255) 　　　　　　'祝日(指定休日)のチェックし、赤色の太文字にします 　　　　　　For Each c In Range("B" & 3 + myRow * (i - 1)).Resize(6, 7) 　　　　　　　　If Application.CountIf(Range("L2:L212"), c.Value) > 0 Then 　　　　　　　　　　c.Font.Color = RGB(255, 0, 0) 　　　　　　　　　　c.Font.Bold = True 　　　　　　　　End If 　　　　　　Next c 　　　　Erase myTable 　　　　Next i 　　Application.ScreenUpdating = True End Sub

年間カレンダーを作成する(その2)　　　topへ

• 上記の縦に羅列するのではなく、横に3か月を並べるタイプの作成例です。
• 上記コードを書き換えたものです。
• 完成例
  • あらかじめ、A列に祝祭日を入力しています。
    
• コード例
  • 基本的な考え方は上のコードをベースにしています。
    データの書き出し位置はD4セルを起点とした書き方にしてみました。
    

    Sub calendar_year4() 　'横に3か月、下に4か月を出力 　' 　　Dim myDate As Integer 　　Dim Nen As Integer, Tuki As Integer 　　Dim i As Integer, j As Long, k As Integer 　　Dim myTitleD, myTitle(1 To 1, 1 To 7) 　　Dim myRow As Integer, myCol As Integer 　　Dim cn As Long, cntCol As Integer, cntRow As Integer 　　Dim c As Range 　　　　'行間隔、列間隔の設定 　　　　myRow = 9 　　　　myCol = 8 　　　　'作成する年を入力します 　　　　myDate = Application.InputBox(Title:="年の指定", _ 　　　　　　　　　　　　　　Prompt:="作成する年を入力してください", _ 　　　　　　　　　　　　　　Default:="2011", Type:=1) 　　　　Nen = myDate 　　　　'曜日を配列にセットします 　　　　myTitleD = Array("日", "月", "火", "水", "木", "金", "土") 　　　　For k = 0 To 6 　　　　　　myTitle(1, k + 1) = myTitleD(k) 　　　　Next k 　　　　'ひと月の日付を配列にセットします 　　　　Range("C:Z").Clear 　　　　Application.ScreenUpdating = False 　　　　For i = 1 To 12 　　　　　　Dim myTable(1 To 6, 1 To 7) 　　　　　　cn = 1 　　　　　　'配置によって列と行の位置を変数で指定します 　　　　　　Select Case i 　　　　　　　　Case 1, 4, 7, 10 　　　　　　　　　　cntCol = 1 　　　　　　　　Case 2, 5, 8, 11 　　　　　　　　　　cntCol = 2 　　　　　　　　Case 3, 6, 9, 12 　　　　　　　　　　cntCol = 3 　　　　　　End Select 　　　　　　Select Case i 　　　　　　　　Case 1 To 3 　　　　　　　　　　cntRow = 1 　　　　　　　　Case 4 To 6 　　　　　　　　　　cntRow = 2 　　　　　　　　Case 7 To 9 　　　　　　　　　　cntRow = 3 　　　　　　　　Case 10 To 12 　　　　　　　　　　cntRow = 4 　　　　　　End Select 　　　　　　For j = DateSerial(Nen, i, 1) To DateSerial(Nen, i + 1, 0) 　　　　　　　　If Day(j) <> 1 And Weekday(j) = 1 Then cn = cn + 1 　　　　　　　　myTable(cn, Weekday(j)) = j 　　　　　　Next j 　　　　　　'シートに書き出します 基準はD4セル=Cells(1,4) 　　　　　　With Cells(1 + myRow * (cntRow - 1), 4 + myCol * (cntCol - 1)) 　　　　　　　　If i = 1 Then .Offset(0, -1).Value = Nen 　　　　　　　　.Value = i 　　　　　　　　.Font.Bold = True 　　　　　　　　.Offset(1, 0).Resize(1, 7).Value = myTitle 　　　　　　　　.Offset(2, 0).Resize(6, 7).Value = myTable 　　　　　　　　'書式を設定します 　　　　　　　　.Offset(1, 0).Resize(1, 7).Interior.Color = RGB(235, 241, 222) 　　　　　　　　.Offset(1, 0).Resize(7, 7).HorizontalAlignment = xlCenter 　　　　　　　　.Offset(2, 0).Resize(6, 7).NumberFormatLocal = "d" 　　　　　　　　'日曜日は赤色にします 　　　　　　　　.Offset(1, 0).Resize(7, 1).Font.Color = RGB(255, 0, 0) 　　　　　　　　'土曜日は青色にします 　　　　　　　　.Offset(1, 6).Resize(7, 1).Font.Color = RGB(0, 0, 255) 　　　　　　　　'祝日(指定休日)のチェックし、赤色の太文字にします 　　　　　　　　For Each c In .Offset(2, 0).Resize(6, 7) 　　　　　　　　　　If Application.CountIf(Range("A1:A100"), c.Value) > 0 Then 　　　　　　　　　　　　c.Font.Color = RGB(255, 0, 0) 　　　　　　　　　　　　c.Font.Bold = True 　　　　　　　　　　End If 　　　　　　　　Next c 　　　　　　End With 　　　　　　Erase myTable 　　　　Next i 　　　　Application.ScreenUpdating = True End Sub

スポンサードリンク

PageViewCounter
　
　Since2006/2/27