エクセルでここまでできる!予定が書き込める万年カレンダー シートの存在を確認し、なければ新規にシートを作成 土日でマスター エクセルVBA講座⑥

今回も、エクセルでの万年カレンダーの作成です。

エクセルで自動万年カレンダーに祝日(2020年)を自動表示 365・2019・2016・2013・2010・2007対応
今回は先日公開した、万年利用できるカレンダーに祝日を自動表示する方法のご紹介です。祝日を自動表示する万年カレンダー年と月を入力するだけで自動的...

前回はコントロールのボタンを利用して、クリック一つで翌月や前月、翌年に移動する方法を記事にしました。

エクセルの万年カレンダーにコントロールボタンを設置してマクロを動かす&エクセルの関数をVBAで利用 土日でマスター エクセルVBA講座⑤
前回は、万年カレンダーにスピンボタンを設置して、年月をクリックすることによって移動させる記事を紹介しました。スピンボタンで年月を移動する万年カレンダー...

今回はカレンダーの月や年を移動してもセルに書き込んだ予定が消えない、まさに一生利用できる万年カレンダーをマクロで作成します。

スポンサーリンク

今回作成カレンダーの仕様の紹介

今回の記事は、先に紹介した2つのカレンダーの記事をご覧になって、万年カレンダーが完成していることと、フォームボタンによる月や年の移動が可能なカレンダーが完成していることが前提となります。

下図のようにセルに予定を書き込みが可能です。

エクセルのカレンダーに予定を書き込む

そして翌月にフォームコントロールボタンによって翌月に移動します。

ここでも予定の書き込みが可能です。

ボタンで翌月に移動

そして今回の最大の機能である、再び前月に戻ると先ほど記入した予定が、下図のよう表示されます。

記入した予定が月を変えても自動で表示される

この機能は、月または年を移動する際に別シートを作成し、マクロによって予定を保存・更新しているために予定が消えることはありません。

実際には、マクロによってこちらのシートは非表示になります。

別シートを作成して予定を管理

それでは、実際のマクロを見てみましょう。

スポンサーリンク

予定を転記・更新するシートを作成・更新するマクロ

まずはカレンダーで翌月に移動する際に、予定を書き込み、移動する月の予定を読み込むマクロの全体像は以下となります。

かなり複雑な処理をしていますので、後から解説していきます。

Sub ボタン3_Click()
myMonth = Range("c1").Value
mySheetName = Replace(Range("c1").Value, "/", "")
'現在の月のシートがあるか確認
For i = 1 To Worksheets.Count
If Worksheets(i).Name = mySheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'現在の月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'現在の月のデータをコピー
Worksheets(mySheetName).Range("a5:g5").Value = Worksheets("カレンダー").Range("a5:g5").Value
Worksheets(mySheetName).Range("a8:g8").Value = Worksheets("カレンダー").Range("a8:g8").Value
Worksheets(mySheetName).Range("a11:g11").Value = Worksheets("カレンダー").Range("a11:g11").Value
Worksheets(mySheetName).Range("a14:g14").Value = Worksheets("カレンダー").Range("a14:g14").Value
Worksheets(mySheetName).Range("a17:g17").Value = Worksheets("カレンダー").Range("a17:g17").Value
Worksheets(mySheetName).Range("a20:g20").Value = Worksheets("カレンダー").Range("a20:g20").Value
'現在の月のワークシートを非表示
Worksheets(mySheetName).Visible = False
'翌月のシートがあるか確認
'12月の場合に注意
If Right(mySheetName, 4) = "1201" Then
myNextSheetName = Trim(mySheetName + 8900)
Else
myNextSheetName = Trim(mySheetName + 100)
End If
For i = 1 To Worksheets.Count
If Worksheets(i).Name = myNextSheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'翌月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myNextSheetName
End If
'翌月のデータをカレンダーにコピー
Worksheets("カレンダー").Range("a5:g5").Value = Worksheets(myNextSheetName).Range("a5:g5").Value
Worksheets("カレンダー").Range("a8:g8").Value = Worksheets(myNextSheetName).Range("a8:g8").Value
Worksheets("カレンダー").Range("a11:g11").Value = Worksheets(myNextSheetName).Range("a11:g11").Value
Worksheets("カレンダー").Range("a14:g14").Value = Worksheets(myNextSheetName).Range("a14:g14").Value
Worksheets("カレンダー").Range("a17:g17").Value = Worksheets(myNextSheetName).Range("a17:g17").Value
Worksheets("カレンダー").Range("a20:g20").Value = Worksheets(myNextSheetName).Range("a20:g20").Value
'翌月のワークシートを非表示
Worksheets(myNextSheetName).Visible = False
'翌月のカレンダーに移動
Worksheets("カレンダー").Range("C1").Value = Application.WorksheetFunction.EDate(myMonth, 1)
Worksheets("カレンダー").Select
End Sub

変数を設定

最初の2行では、現在表示されている月のシート名を取得しています。

まず変数myMonthで現在のカレンダーの年月を取得しています。例えばC1セルに2020/08/01が格納されていると、その月の予定を転記するためのシート名を作成します。

シート名に「/」は利用できないため、現在の年月のシート名は「20200801」としています。

2行目の「Replace関数」では、「2020/08/01」の「/」を消去した「20200801」を現在の月のシート名であるmySheetNameという変数に格納しています。

myMonth = Range("c1").Value
mySheetName = Replace(Range("c1").Value, "/", "")

現在の月のシート名がすでにあるかどうかを判定するマクロ

下記のマクロでは、現在の月のシート「20200801」が存在するかどうかを判定しています。

すでにシートが存在すればmyFlagという変数にTrueを、存在しないとFalseとしています。

方法はWorksheets.Countで存在するシートの数だけFor Nextループでチェックし、存在すればmyFlagをTrueにし、存在しなければFalseとしています。

'現在の月のシートがあるか確認
For i = 1 To Worksheets.Count
If Worksheets(i).Name = mySheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
成績個票を自動でプリントアウト 繰り返し作業を実行する「For」「Next」構文+おまじない 土日でマスター エクセルVBA講座②
今回は、成績データから個人の個票を順番に自動的に印刷していくマクロを作成したいと思います。繰り返しの作業を実行するには、「For」「Next」構文(ステートメ...

現在月のシートが存在しなければ新規にシートを作成

先ほどのFor Nextループで確定させたフラグで、シートがすでに存在すれば何もせず、シートが存在しなければシートを新規に作成します。

If構文でmyFlagがFalse(シートが存在しない)ならば、mySheetNameに格納した名前のシートを最後尾に作成しています(myFlagがTrueならば何もしない)。

'現在の月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If

現在の月の予定を現在の月シートにコピー

こちらはちょっと力業ですが(笑)、カレンダーの予定を書き込む部分のセルの値をここではmySheetNameである「20200801」シートにコピーをしています。

そして最後に、現在の月のシートを非表示にしています。

'現在の月のデータをコピー
Worksheets(mySheetName).Range("a5:g5").Value = Worksheets("カレンダー").Range("a5:g5").Value
Worksheets(mySheetName).Range("a8:g8").Value = Worksheets("カレンダー").Range("a8:g8").Value
Worksheets(mySheetName).Range("a11:g11").Value = Worksheets("カレンダー").Range("a11:g11").Value
Worksheets(mySheetName).Range("a14:g14").Value = Worksheets("カレンダー").Range("a14:g14").Value
Worksheets(mySheetName).Range("a17:g17").Value = Worksheets("カレンダー").Range("a17:g17").Value
Worksheets(mySheetName).Range("a20:g20").Value = Worksheets("カレンダー").Range("a20:g20").Value
'現在の月のワークシートを非表示
Worksheets(mySheetName).Visible = False
スポンサーリンク

移動する月のシートからデータを読み取る

続いて、移動する月のシートからデータを読み取るマクロです。

移動先の月のシートの名前を計算から求める

まず始めに、翌月のシート名をmyNextSheetNameという変数に格納します。

myNextSheetNameは、mySheetNameに100を足すだけで翌月になります(20200901-20200801=100)。

ただし、12月から翌月に移動する場合は注意が必要ですので、IF Else End If構文で条件分岐をしています。

自分でエクセルの関数を作ってみよう! 数字を丸数字に変換 ユーザー定義関数と「If」「Else」「ElseIf」「End If」構文 土日でマスター エクセルVBA講座④
エクセルではマクロを使って、エクセル標準で装備されていない関数を自分で作って利用することが可能です。自分でマクロを利用して作成する関数を「ユーザー定義関数」と...

例として20210101-20201201=8900となりますので、12月からの移動の場合は8900を加算しています。

またTrim関数は、計算によって発生する余分なスペースを取り除く関数です。

'翌月のシートがあるか確認
'12月の場合に注意
If Right(mySheetName, 4) = "1201" Then
myNextSheetName = Trim(mySheetName + 8900)
Else
myNextSheetName = Trim(mySheetName + 100)
End If

移動先の月のシートがなければ新規作成

そしてmySheetNameと同様に、移動先の月のシートmyNextSheetNameがすでに存在するかどうかを判定し、なければ翌月のシートを、シート名mySheetNameとして新規作成します。

For i = 1 To Worksheets.Count
If Worksheets(i).Name = myNextSheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'翌月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myNextSheetName
End If

移動先の月シートからデータを読み込む

移動する先のシートからデータを読み込みます。こちらも力業です。

そして移動先の月データを含んだシート(myNextSheetName)を非表示にした後、EDATE関数によってC1セルの月を一つ増やしています。

さらに最後に、念のためシート「カレンダー」を選択するマクロを記述しています。

'翌月のデータをカレンダーにコピー
Worksheets("カレンダー").Range("a5:g5").Value = Worksheets(myNextSheetName).Range("a5:g5").Value
Worksheets("カレンダー").Range("a8:g8").Value = Worksheets(myNextSheetName).Range("a8:g8").Value
Worksheets("カレンダー").Range("a11:g11").Value = Worksheets(myNextSheetName).Range("a11:g11").Value
Worksheets("カレンダー").Range("a14:g14").Value = Worksheets(myNextSheetName).Range("a14:g14").Value
Worksheets("カレンダー").Range("a17:g17").Value = Worksheets(myNextSheetName).Range("a17:g17").Value
Worksheets("カレンダー").Range("a20:g20").Value = Worksheets(myNextSheetName).Range("a20:g20").Value
'翌月のワークシートを非表示
Worksheets(myNextSheetName).Visible = False
'翌月のカレンダーに移動
Worksheets("カレンダー").Range("C1").Value = Application.WorksheetFunction.EDate(myMonth, 1)
Worksheets("カレンダー").Select

これでほぼ完成です。あとは上記のマクロをコピーして微調整するだけです。

スポンサーリンク

ひと月前に戻るボタンのマクロはコピー&微調整で簡単に

ひと月前に戻るボタンは、先ほど完成した「Sub ボタン3_Click()」のマクロ部分をコピーして、微調整するだけです。

以下に示しています。変更箇所は赤字にしてあります。

変更点は3か所です。

ただし今度は前月に戻るマクロですから、シートが1月の場合の条件分岐に注意が必要です。

Sub ボタン4_Click()
myMonth = Range("c1").Value
mySheetName = Replace(Range("c1").Value, "/", "")
Dim myFlag As Boolean
'現在の月のシートがあるか確認
For i = 1 To Worksheets.Count
If Worksheets(i).Name = mySheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'現在の月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'現在の月のデータをコピー
Worksheets(mySheetName).Range("a5:g5").Value = Worksheets("カレンダー").Range("a5:g5").Value
Worksheets(mySheetName).Range("a8:g8").Value = Worksheets("カレンダー").Range("a8:g8").Value
Worksheets(mySheetName).Range("a11:g11").Value = Worksheets("カレンダー").Range("a11:g11").Value
Worksheets(mySheetName).Range("a14:g14").Value = Worksheets("カレンダー").Range("a14:g14").Value
Worksheets(mySheetName).Range("a17:g17").Value = Worksheets("カレンダー").Range("a17:g17").Value
Worksheets(mySheetName).Range("a20:g20").Value = Worksheets("カレンダー").Range("a20:g20").Value
'翌月のシートがあるか確認
'1月の場合に注意
If Right(mySheetName, 4) = "0101" Then
myNextSheetName = Trim(mySheetName - 8900)
Else
myNextSheetName = Trim(mySheetName - 100)
End If
For i = 1 To Worksheets.Count
If Worksheets(i).Name = myNextSheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'翌月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myNextSheetName
End If
'翌月のデータをカレンダーにコピー
Worksheets("カレンダー").Range("a5:g5").Value = Worksheets(myNextSheetName).Range("a5:g5").Value
Worksheets("カレンダー").Range("a8:g8").Value = Worksheets(myNextSheetName).Range("a8:g8").Value
Worksheets("カレンダー").Range("a11:g11").Value = Worksheets(myNextSheetName).Range("a11:g11").Value
Worksheets("カレンダー").Range("a14:g14").Value = Worksheets(myNextSheetName).Range("a14:g14").Value
Worksheets("カレンダー").Range("a17:g17").Value = Worksheets(myNextSheetName).Range("a17:g17").Value
Worksheets("カレンダー").Range("a20:g20").Value = Worksheets(myNextSheetName).Range("a20:g20").Value
'翌月のカレンダーに移動
Worksheets("カレンダー").Range("C1").Value = Application.WorksheetFunction.EDate(myMonth, -1)
Worksheets("カレンダー").Select
End Sub
スポンサーリンク

1年後に進む・1年前に戻るマクロもコピー&微調整で簡単に

ここまでくれば1年後に進む・1年前に戻るは非常に簡単です。12月や1月の判定も不要です。単純に12か月を足すまたは引く計算になります。

1年後に進むマクロ

まずは1年後に進むボタンからです。注意点は赤字にしています。意味はもうお分かりいただけると思います。

具体的には、myNextSheetNameに10000を足すことと、EDATE関数の引数を12にします。

Sub ボタン5_Click()
myMonth = Range("c1").Value
mySheetName = Replace(Range("c1").Value, "/", "")
Dim myFlag As Boolean
'現在の月のシートがあるか確認
For i = 1 To Worksheets.Count
If Worksheets(i).Name = mySheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'現在の月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'現在の月のデータをコピー
Worksheets(mySheetName).Range("a5:g5").Value = Worksheets("カレンダー").Range("a5:g5").Value
Worksheets(mySheetName).Range("a8:g8").Value = Worksheets("カレンダー").Range("a8:g8").Value
Worksheets(mySheetName).Range("a11:g11").Value = Worksheets("カレンダー").Range("a11:g11").Value
Worksheets(mySheetName).Range("a14:g14").Value = Worksheets("カレンダー").Range("a14:g14").Value
Worksheets(mySheetName).Range("a17:g17").Value = Worksheets("カレンダー").Range("a17:g17").Value
Worksheets(mySheetName).Range("a20:g20").Value = Worksheets("カレンダー").Range("a20:g20").Value
'翌月のシートがあるか確認
myNextSheetName = Trim(mySheetName + 10000)
For i = 1 To Worksheets.Count
If Worksheets(i).Name = myNextSheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'翌月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myNextSheetName
End If
'翌月のデータをカレンダーにコピー
Worksheets("カレンダー").Range("a5:g5").Value = Worksheets(myNextSheetName).Range("a5:g5").Value
Worksheets("カレンダー").Range("a8:g8").Value = Worksheets(myNextSheetName).Range("a8:g8").Value
Worksheets("カレンダー").Range("a11:g11").Value = Worksheets(myNextSheetName).Range("a11:g11").Value
Worksheets("カレンダー").Range("a14:g14").Value = Worksheets(myNextSheetName).Range("a14:g14").Value
Worksheets("カレンダー").Range("a17:g17").Value = Worksheets(myNextSheetName).Range("a17:g17").Value
Worksheets("カレンダー").Range("a20:g20").Value = Worksheets(myNextSheetName).Range("a20:g20").Value
'翌月のカレンダーに移動
Worksheets("カレンダー").Range("C1").Value = Application.WorksheetFunction.EDate(myMonth, 12)
Worksheets("カレンダー").Select
End Sub

1年前に戻るマクロ

1年前に戻るマクロも、mySheetNameに10000を引き、EDATE関数の引数を-12とするだけです。

Sub ボタン6_Click()
myMonth = Range("c1").Value
mySheetName = Replace(Range("c1").Value, "/", "")
Dim myFlag As Boolean
'現在の月のシートがあるか確認
For i = 1 To Worksheets.Count
If Worksheets(i).Name = mySheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'現在の月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = mySheetName
End If
'現在の月のデータをコピー
Worksheets(mySheetName).Range("a5:g5").Value = Worksheets("カレンダー").Range("a5:g5").Value
Worksheets(mySheetName).Range("a8:g8").Value = Worksheets("カレンダー").Range("a8:g8").Value
Worksheets(mySheetName).Range("a11:g11").Value = Worksheets("カレンダー").Range("a11:g11").Value
Worksheets(mySheetName).Range("a14:g14").Value = Worksheets("カレンダー").Range("a14:g14").Value
Worksheets(mySheetName).Range("a17:g17").Value = Worksheets("カレンダー").Range("a17:g17").Value
Worksheets(mySheetName).Range("a20:g20").Value = Worksheets("カレンダー").Range("a20:g20").Value
'翌月のシートがあるか確認
myNextSheetName = Trim(mySheetName - 10000)
For i = 1 To Worksheets.Count
If Worksheets(i).Name = myNextSheetName Then
myFlag = True
Exit For
Else
myFlag = False
End If
Next i
'翌月のシートがなければ新規作成
If myFlag = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myNextSheetName
End If
'翌月のデータをカレンダーにコピー
Worksheets("カレンダー").Range("a5:g5").Value = Worksheets(myNextSheetName).Range("a5:g5").Value
Worksheets("カレンダー").Range("a8:g8").Value = Worksheets(myNextSheetName).Range("a8:g8").Value
Worksheets("カレンダー").Range("a11:g11").Value = Worksheets(myNextSheetName).Range("a11:g11").Value
Worksheets("カレンダー").Range("a14:g14").Value = Worksheets(myNextSheetName).Range("a14:g14").Value
Worksheets("カレンダー").Range("a17:g17").Value = Worksheets(myNextSheetName).Range("a17:g17").Value
Worksheets("カレンダー").Range("a20:g20").Value = Worksheets(myNextSheetName).Range("a20:g20").Value
'翌月のカレンダーに移動
Worksheets("カレンダー").Range("C1").Value = Application.WorksheetFunction.EDate(myMonth, -12)
Worksheets("カレンダー").Select
End Sub

以上で、予定を書き込むことができる、エクセルの万年カレンダーとなります。

今回はマクロの講座というよりも発想の賜物かもしれません。カレンダーだけではなく他にも応用が利くのではないでしょうか。

不明な点があればコメントいただけたらご回答いたします。

追記:ここまで記事にしておいてなんなんですが、このカレンダーは完成品ではありません。

と言うのも、当該月以外の日付に予定を入れることはできますが、翌月になると表示できません。

当該月の予定は書き込める

翌月に移動すると、下図のように9月30日の予定は表示されなくなります。

前月のデータが表示されない

こちらについては、後日「完全版」を投稿いたします。

追記:完全版を作成しました。下記の記事をご覧ください。

エクセルで予定が書き込める・祝日自動表示する万年カレンダー完全版 ダイアリー風|リーダーの独り言|note
今回の記事も、本家ブログでは未公開です。 下記のリンクは、マクロを駆使して、予定を書込み・修正・削除が自由自在に行える、エクセルの万年カレンダーを作成する記事です。 エクセルでここまでできる!予定が書き込める万年カレンダー シートの存在を確認し、なければ新規にシートを作成 土日でマスター エクセルVBA講座⑥ ...

追記:形式が違いますが、予定の書き込みができるエクセルの全自動万年カレンダーを作成しました。

note上で公開しています。

ぜひご覧ください。

予定が書き込める万年カレンダー VBA(マクロ)を使えばエクセルでもこれだけできる! 祝日自動表示も可能!|リーダーの独り言|note
こちらの内容は本家ブログでも公開していません。 下記の記事を応用して、予定を書きこみやすくしたカレンダーになります。 エクセルで自動万年カレンダーに祝日(2020年)を自動表示 365・2019・2016・2013・2010・2007対応 永遠に使えるエクセルの万年カレンダーに予定を書込み・削除可能で、いつま...
スポンサーリンク
エクセルVBA
スポンサーリンク
リーダーの独り言

コメント

タイトルとURLをコピーしました