1. Home »
2. Excel VBA入門:目次 »
3. 誕生日カレンダーを作成する

• 会社でバースデー休暇の設定が有ったりすると、社員の誕生日のカレンダーを作成することがあるかもしれません。
  また、学校などでは低学年では誕生会などといった時間が有ったりしました。
• ここでは、月別のカレンダーに該当する人の名前を書き出します。

カレンダーを作成する topへ

• 「1月」〜「12月」のシートを作成します。
  A1セルには カレンダーの月数を表示しています。 「2015年1月1日」と入力して、表示形式を「yyyy"年"m"月"」としています。
  A4セルには =IF(MONTH(DATE(YEAR($A1ドル),MONTH($A1ドル),ROW(A1)))<>MONTH($A1ドル),"",DATE(YEAR($A1ドル),MONTH($A1ドル),ROW(A1))) と入力しています。
  これを A35セルまでコピーしています。
  B4セルには =TEXT(A4,"(aaa)") と入力して、曜日を表示しています。
  
• シート「名簿」には社員の誕生日が入力されています。
  
• コードの作成例です。
  • Sub test()
    Dim myBirthday()
    Dim myMonth As Integer
    
    Dim i As Integer, j As Integer, k As Integer
    
    '入力範囲をクリアする
    For j = 1 To 12
    Worksheets(j & "月").Range("C4:L34").Clear
    Next j
    'カレンダーに転記する---ダミーデータ1000この処理例です----
    myBirthday = Worksheets("名簿").Range("A2:C1001").Value
    
    For i = 1 To UBound(myBirthday)
    myMonth = Month(myBirthday(i, 3))
    Worksheets(myMonth & "月").Cells(3 + Day(myBirthday(i, 3)), 1).End(xlToRight).Offset(0, 1).Value = _
    myBirthday(i, 2) & vbLf & Format(myBirthday(i, 3), "gge.m.d")
    Next i
    
    End Sub
    
  • シート名簿の名前と誕生日(生年月日)のデータ範囲を配列myBirthday に格納します。
    myBirthday = Worksheets("名簿").Range("A2:C1001").Value
  • データを順番に調べていきます。
    誕生月は myMonth = Month(myBirthday(i, 3)) と変数myMonthに格納しています。
    転記するシートは Worksheets(myMonth & "月"). となります。
  • 転記先の 行位置は 1日が 4行目から始まっているので、 誕生日の日に+3 した値の行が転記する行になります。
    Cells(3 + Day(myBirthday(i, 3)), 1)
  • 転記先がすでに入力されているケースがありますので、その行の最右端のセルの右隣に入力することになります。
    .End(xlToRight).Offset(0, 1)
  • 転記するのは名前と誕生日を2行にして転記することにしました。
    誕生日は和暦としました。 Format(myBirthday(i, 3), "gge.m.d")
  • コードは↓の1行をデータの数だけループで回しているだけです。
    Worksheets(myMonth & "月").Cells(3 + Day(myBirthday(i, 3)), 1).End(xlToRight).Offset(0, 1).Value = myBirthday(i, 2) & vbLf & Format(myBirthday(i, 3), "gge.m.d")
• 実行結果の例
  • 2月の結果
    
  • 2月の全体のようす
    

スポンサードリンク
(追記) (追記ここまで)

PageViewCounter
Counter
Since2006/2/27