【エクセルVBAでカレンダー作り】DoLoopとDateAdd関数を使って日付を書き出す方法

2019年8月3日
2019年8月31日
カレンダーアプリ
Dowhile, VBA, カレンダー

カレンダーアプリ

みなさん、こんにちはケンケンです。

エクセルVBAでできるカレンダー作りをご紹介しています。

前回は、CDate関数を使って日付データの取得を勉強しました。

今回は、取得した日付を一日ずつシートに書き出してみたいと思います。

少しずつカレンダーっぽくなっていきますのでお付き合い下さい。

1 前回の復習とコード
2 日付をシートに書き出す
3 まとめ

前回の復習とコード

前回は、CDate関数の使い方を主に勉強しましたね。

コードは以下のようになります。

Sub hiduke_rensyu0()
    Dim sday '最初の日という意味
    Dim ntuki '次の月を格納
    Dim stuki '翌月の最初の日を格納
    Dim lday '最後の日という意味
    
    ntuki = Range("D2").Value + 1
    If ntuki = 13 Then
        ntuki = 1
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    Else
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    End If
    
    Range("A1").Value = sday
    Range("B1").Value = lday
    

End Sub

Sub hiduke_rensyu0()

Dim sday '最初の日という意味

Dim ntuki '次の月を格納

Dim stuki '翌月の最初の日を格納

Dim lday '最後の日という意味

ntuki = Range("D2").Value + 1

If ntuki = 13 Then

ntuki = 1

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")

lday = stuki - 1

Else

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")

lday = stuki - 1

End If

Range("A1").Value = sday

Range("B1").Value = lday

End Sub

IF構文と組み合わせることで１２月分もエラーなく表示させることができました。

今回は、シートに表示させる方法を工夫して、１か月分を１日ずつ表示できるようにチャレンジしていきます。

日付をシートに書き出す

条件を指定し、その条件の間だけ繰り返す構文です。

Do While 条件式

繰り返し処理

Loop

上記が構文となります。

上記のほかにもWhileではなく、Untilを使ったりWhileの位置をLoopの後にもってきたりすることもできます。

今回は、深堀りせずDoWhile～Loopだけ紹介します。

ForNext構文とは異なり、常に最終値が一定でないときや不明な時に使えます。

過去にも紹介していますのでよろしかったらこちらをご覧ください。

Do～Loopを使ってみよう

それではこの構文を使って練習してみましょう。

Sub DoLoop_rensyu()
    Dim cnt
    cnt = 1
    
    Do While cnt <= 10
        Range("A" & cnt).Value = cnt
        cnt = cnt + 1
    Loop
End Sub

Sub DoLoop_rensyu()

Dim cnt

cnt = 1

Do While cnt <= 10

Range("A" & cnt).Value = cnt

cnt = cnt + 1

Loop

End Sub

上記のようにコードを書きます。

変数cntを用意して初期値を１とします。

条件式は、cntの値が１０になるまで以降の処理をすることとします。

繰り返す処理は、A列に変数に格納されている値を書き出し、書き出した後、変数cntに＋１することです。

これを実行すると、以下のようになります。

DateAdd関数を使ってみよう

日付を書き出すのに便利なDateAdd関数をご紹介します。

この関数は、指定した間隔で日付を表示してくれます。

書式は

DateAdd(interval, number, date)

intervalは、追加する時間間隔を指定します。

numberは、追加する時間間隔の数を指定します。１日だったら「１」、２日だったら「２」のように

dateは、元となる日付を指定します。

言葉で説明してもよく分かりませんね。

実際にコードを書いて挙動を確認してみましょう。

Sub DateAdd_rensyu()
    Dim motoDate
    
    motoDate = "2020/7/24"
    Range("A1").Value = DateAdd("d", 1, motoDate) '①
    Range("A2").Value = DateAdd("m", 1, motoDate) '②
    Range("A3").Value = DateAdd("q", 1, motoDate) '③
    Range("A4").Value = DateAdd("d", -1, motoDate) '④
End Sub

Sub DateAdd_rensyu()

Dim motoDate

motoDate = "2020/7/24"

Range("A1").Value = DateAdd("d", 1, motoDate) '①

Range("A2").Value = DateAdd("m", 1, motoDate) '②

Range("A3").Value = DateAdd("q", 1, motoDate) '③

Range("A4").Value = DateAdd("d", -1, motoDate) '④

End Sub

上記が実行結果になります。

コードの解説をします。

まず、motoDateという変数を用意します。この変数には2020/7/24という文字列を格納しておきます。

①2020/7/24に１日加えた日付を表しています。

第１引数の”d”はdayを表します。

第２引数の１は間隔を表しており、この場合は「プラス１日後」という意味です。３に設定すると３日後の値が返ってきます。

第３引数は元となる日付である2020/7/24が変数の形式で入っています。

②第１引数の”m”はmonthを表します。

第２、第３引数は先ほどと同じです。

実行結果は「元の日付の１月後」が返ってきます。

③第１引数の”q”はquarterを表します。四半期のことです。ちょっとおもしろいですね。

第２引数を１とすると、元の日付の３か月後が表示されます。

④第２引数にマイナスの値を入れると、過去の日数を取得します。

マイナス１日になるので2020/7/23と表示されます。

指定した期間の日付を書き出してみよう

それでは、今回の目的である指定した期間分の日付を書き出す作業をDoLoopとDateAddを使って実現させます。

前回作ったコードに以下のように追加します。

Sub hiduke_rensyu0()
    Dim sday '最初の日という意味
    Dim ntuki '次の月を格納
    Dim stuki '翌月の最初の日を格納
    Dim lday '最後の日という意味
    
    ntuki = Range("D2").Value + 1
    If ntuki = 13 Then
        ntuki = 1
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    Else
        sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")
        stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")
        lday = stuki - 1
        
    End If
    
    
    Dim cnt '書き出し先のカウント変数'①
    cnt = 2 '②
    Do While sday <= lday '③
        Range("A" & cnt).Value = sday
        sday = DateAdd("d", 1, sday) '④
        cnt = cnt + 1 '⑤
    Loop
End Sub

Sub hiduke_rensyu0()

Dim sday '最初の日という意味

Dim ntuki '次の月を格納

Dim stuki '翌月の最初の日を格納

Dim lday '最後の日という意味

ntuki = Range("D2").Value + 1

If ntuki = 13 Then

ntuki = 1

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") + 1 & "/" & ntuki & "/" & "1")

lday = stuki - 1

Else

sday = CDate(Range("C2") & "/" & Range("D2") & "/" & "1")

stuki = CDate(Range("C2") & "/" & ntuki & "/" & "1")

lday = stuki - 1

End If

Dim cnt '書き出し先のカウント変数'①

cnt = 2 '②

Do While sday <= lday '③

Range("A" & cnt).Value = sday

sday = DateAdd("d", 1, sday) '④

cnt = cnt + 1 '⑤

Loop

End Sub

22行目以降を追加してください。

コードの解説をします。

①シートへ書き出すための変数が必要なので、カウント変数cntを用意しました。

ちなみに、変数の宣言はプロシージャ内のどこでもできるので、先頭ではなく途中の方が分かり易そうだったら途中でも問題ありません。

②変数cntの初期値は２としました。２行目から書き出すためです。

③DoLoopを使って処理を回します。

条件式は、sdayから始まってsdayの値がldayと同等になるまで以下の処理を繰り返してね、という意味です。

2020年の12月を指定すると、sdayには2020/12/1がldayには2020/12/31が格納されますので、その間だけ処理が繰り返されます。

④sdayの値をA列に書き出したら、DateAdd関数を使って１日後を算出します。

そして、その結果を変数sdayに格納します。元々sdayが12/1だったら12/2と変更されます。

⑤書き出し先の変数cntにプラス１することを忘れないようにしましょう。

忘れると同じセルにデータが上書きされていってしまいます。

試しにこのコードを削除して実験してみてください。

以降は③に戻って2020/12/31まで処理が繰り返されます。

コードを実行して下図のように書き出せていれば成功です。

まとめ

いかがでしたか。

今回は、DoLoopとDateAdd関数を組み合わせて自在に日付を書き出す方法をご紹介しました。

次回は、OFFSETやVLOOKUPを使って検索して転記する方法をご紹介しますのでお楽しみに。

それでは、また次回お会いしましょう。

カレンダーアプリ作成関連記事一覧

【エクセルでカレンダー作成】シリアル値の概念を知り日付関数の基礎をマスター

【エクセルでカレンダー作成】日付と曜日を表現する関数をマスターしよう

【エクセルでカレンダー作成】作業列を設けてカレンダー作りにとりかかる

【エクセルでカレンダー作成】VLOOKUP関数と条件付き書式でカレンダーを作りこむ

【エクセルVBA】VBAでカレンダーを作るときに最も重要な関数

【エクセルVBAでカレンダー作り】DoLoopとDateAdd関数を使って日付を書き出す方法

【エクセルVBAでカレンダー作り】OFFSETとVLOOKUPを使って検索抽出する方法

【エクセルVBA】別シートからカレンダーに行事を転記する方法

【エクセルVBA】カレンダーの土日だけ色を変える方法とRangeオブジェクトの応用的な使い方

【エクセルVBA】プロシージャをまとめてカレンダーを完成させよう