1. Home » 
2. Excel VBA入門：目次 » 
3. 指定年月日からの年間カレンダーを作成する

指定年月日からの年間カレンダーを作成する:Excel VBA入門

スポンサードリンク

指定年月日からの年間カレンダーを作成する　　　topへ

• 掲示板にて、3月21日始まりの年間カレンダーの作り方の質問がありました。
  年間カレンダーを作成するをベースにコードを書き換えることで作成してみました。
  • 下図の2011/1/3など祝日以外に「指定休日」が設定してありますので、通常のカレンダーとは異なっています。
    後述の「祝日(指定休日)リスト」によって判定していますことを付記しておきます。
  
• コードの作成例です。
  • 【例】データは配列に入れてシートへ書き出すようにしています。
    • 1月〜12月をループしてシートに書き出しています。
      そのため配列myTableはその都度設定しクリアしています。
    • 10行おきに書き出すためにgyoukan = 10　としています。10の部分を書き換えることで間隔を変えることができます。
    • 1904年日付システムでは不具合がありましたのでコードを修正しました。(2011/5/12)
      • [XL] 1900 年から計算する日付システムと 1904 年から計算する日付システム
        http://support.microsoft.com/kb/180162/ja

    Sub calendar_year3() ' '指定日からの年間カレンダー ' 　　Dim myDate As String 　　Dim Nen As Integer, Tuki As Integer, hi As Integer 　　Dim gyoukan As Integer, gyou As Integer 　　Dim i As Integer, j As Long, k As Integer 　　Dim cn As Long 　　Dim c As Range 　　Dim myTitleD, myTitle(1 To 1, 1 To 7) 　　　　'表示行の間隔を指定しています 　　　　gyoukan = 10 　　　　'作成する年を入力します 　　　　myDate = Application.InputBox(Title:="1年間のカレンダー作成", _ 　　　　　　　　　　　　　Prompt:="作成開始の年月日を2011/1/1 の形式で入力してください", _ 　　　　　　　　　　　　　Default:="2011/1/1", Type:=2) 　　　　Nen = Year(myDate) 　　　　Tuki = Month(myDate) 　　　　hi = Day(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 = Tuki To Tuki + 11 　　　　　　Dim myTable(1 To 6, 1 To 7) 　　　　　　cn = 1 　　　　　　For j = DateSerial(Nen, i, hi) To DateSerial(Nen, i + 1, hi - 1) 　　　　　　　　If Day(j) <> hi And Weekday(j) = 1 Then cn = cn + 1 　　　　　　　　myTable(cn, Weekday(j)) = Format(j , "yyyy/m/d") 　　　　　　Next j 　　　　　　'シートに書き出します 　　　　　　gyou = gyou + 1 　　　　　　Range("A" & 1 + gyoukan * (gyou - 1)).Value = DateSerial(Nen, i, 1) 　　　　　　Range("B" & 2 + gyoukan * (gyou - 1)).Resize(1, 7).Value = myTitle 　　　　　　Range("B" & 3 + gyoukan * (gyou - 1)).Resize(6, 7).Value = myTable 　　　　　　'書式を設定します 　　　　　　Range("A" & 1 + gyoukan * (gyou - 1)).NumberFormatLocal = "yyyy""年""m""月""" 　　　　　　Range("B" & 2 + gyoukan * (gyou - 1)).Resize(7, 7).HorizontalAlignment = xlCenter 　　　　　　Range("B" & 3 + gyoukan * (gyou - 1)).Resize(6, 7).NumberFormatLocal = "d" 　　　　　　'日曜日は赤色,土曜日は青色にします 　　　　　　Range("B" & 2 + 10 * (gyou - 1)).Resize(6, 1).Font.Color = RGB(255, 0, 0) 　　　　　　Range("H" & 2 + 10 * (gyou - 1)).Resize(6, 1).Font.Color = RGB(0, 0, 255) 　　　　　　'祝日(指定休日)のチェックし、赤色の太文字にします 　　　　　　For Each c In Range("B" & 3 + gyoukan * (gyou - 1)).Resize(6, 7) 　　　　　　　　'この例では祝日や指定休日のリストがL2:L212に入力してあります 　　　　　　　　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

スポンサードリンク

PageViewCounter
　
　Since2006/2/27