西暦からイースターの日付を出力するマクロ

　本日の午前中も、就労移行支援事業所に行って参りました。いまはエクセルのマクロの練習です。まずは、学校の教員だった時代に頼っていた「時間割マクロ」の完成です。時間割を作成するマクロではありません（それができたらすごすぎでしょう。それこそ商売になる）。担当者別のシートに学年とクラスを入力すると、クラス別のシートに「時間割」が書かれるマクロです。その学校（辞めることは決まっていますが、まだ微妙に勤めています）で、長いこと使われているマクロを少し超えるように作りました。長年使われているマクロは、たとえば社会で「日本史」「世界史」「地理」の選択で、２クラスが合同して３クラスになって授業をする場合、担当者のひとりしか書かれないという欠点がありました。私のマクロはそういう場合、ちゃんと「選択社会」と表記されます。もちろん体育の「柔道」「保健」「水泳」も対応します。さらに、クラスが増えても自動的に調節します。それはともかく、それを完成させて、本日のメインは、「教会暦マクロ」です。

　今年（２０２２年）のイースターは何月何日かご存知でしょうか。４月１７日なのですが、イースターの日付は、毎年かなり変わります。春分の日を過ぎた最初の満月の日を過ぎた最初の日曜と決まっているからです。

　私のマクロは、実行するとまず計算を始める年と終わる年を聞いて来ます。たとえば「2016年」と「2025年」と答えますと、2016年から2025年までの「灰の水曜日（レントの初日）」と「受難日」と「イースター」と「昇天日」と「ペンテコステ」が出力されます。サムネにスクショをはっておきました。こんな感じで出ます。

　今回の私のマクロは、「イースターの計算」で検索して出る「国立天文台暦計算室」というサイトに載っていた計算式をそのまま使わせていただきましたので、私はなにも偉くないです。そして、それ以外の日付は、そこから逆算しています。たとえば「灰の水曜日」ならば、イースターの４６日前とか、ペンテコステならイースターの４９日後、みたいな感じで、そこは泥臭くやっています。最後にコードをさらすつもりですが、恥ずかしいですのであまりまじまじと見ないでくださいね。

　この「いつがイースターか」「いつがペンテコステか」というのは、クリスチャンにとっては重要で、たいがい週報で知るか、私みたいにあまり教会に行っていない人間は、ネット検索で知るか、というところだと思います。だいたいいまくらいの時期にいつからレント（受難節、四旬節）なのかが気になる感じです。私はずっと、イースターが日本で根付かないのは、３月下旬から４月下旬になりますから、４月で年度の変わる日本では、年度をまたぐので行事にもなりにくいし、というところだと思っていましたが、なぜかここ十年くらいでしょうか、イースターが少し定着してきているというか、商業化（？）しつつある感じですね。たまごとうさぎの日です。（教会ではキリストの復活を祝う日です。たまごもやりますが、コロナ以降どうなったかよく知りません。）このプログラムがヨーロッパで需要があるのは、だいたい理由が想像できます。ノルウェー人の友人が言っていたのですが、ノルウェーではイースターの前後２週間は「イースター休み」だと。日本のお盆休みみたいなものでしょうね。だから、宗教的理由というよりは「いつが休みなのか」というニーズがあるのだろうと思います。（そのノルウェーの友人の話では、ノルウェーでは国民の８割は幼児洗礼を受けているけど、皆さん教会に来ないし、「主の祈り」も暗唱していないし、クリスマスだけ大量に来るし、とのことでした。日本の初もうで状態ですね。だから、ノルウェー人がそんなに宗教的に熱心であるとは思えないのです。彼はノルウェー人としてはかなりまれなタイプだったことになります。だいたいヨーロッパはそんな感じでしょうかね。だからイースターマクロの需要は、ほぼ休暇の計算だろうと思います。）

　インターネットで「イースターの計算」で検索して、エクセルでイースターの計算をする方法が出て来ます。それをぱくることはしていません。ただし、それを見ていると「どうだ、すごいものを作っただろう」という文体ではありません（すごいものを作った人は、自然とそういう文体になります。私も含めてね）。とても謙虚な文体です。よくよく最後まで見ると、どうやらプログラミングの会社の宣伝のようでした。しかも、そこに載っていたエクセルでイースターの計算をするマクロは、ユーザー定義関数を作って、日付を意味する整数を出す関数を作り、それをエクセルに書かせたうえで、書式を日付に直すということをやらせようとしていました。私の知っている限りでは、そのやりかただと、あまりエクセルに詳しくない人はもうできなかったりします。私のはもっと親切で、ボタンを押して西暦を入力するだけで書きます。便利でしょう。わずかな時間でできましたよ。上述の通り、肝心の数式は借り物ですけどね。

　以下にプログラムをさらします。恥ずかしいのでまじまじと見ないでくださいね。

Sub イースター()
Dim x, y, g, c, k, h, i, j, l, m, d, mhai, dhai, mjunan, djunan, mshouten, dshouten, mpen, dpen As Integer
Do
y1 = InputBox("始める西暦を入力してください")
y2 = InputBox("終了する西暦を入力してください")
Loop Until y1 <= y2

Range("A4").Value = "年"
Range("B4").Value = "灰の水曜日"
Range("C4").Value = "受難日"
Range("D4").Value = "イースター"
Range("E4").Value = "昇天日"
Range("F4").Value = "ペンテコステ"


For x = y1 To y2
y = x
g = y Mod 19
c = Int(y / 100)
k = Int((c - 17) / 25)
h = (19 * g + 15 + c - Int(c / 4) - Int((c - k) / 3)) Mod 30
i = h - Int(h / 28) * (1 - Int(29 / (h + 1)) * Int((21 - g) Mod 11))
j = (y + Int(y / 4) - c + Int(c / 4) + i + 2) Mod 7
l = i - j
m = 3 + Int((l + 40) / 44)
d = l + 28 - 31 * Int(m / 4)

dhai = d - 46
mhai = m
Do While dhai < 1
If mhai = 4 Then
mhai = mhai - 1
dhai = dhai + 31
ElseIf mhai = 3 Then
mhai = mhai - 1
If y Mod 4 = 0 And y Mod 100 <> 0 Then
dhai = dhai + 29
Else
dhai = dhai + 28
End If
End If
Loop

djunan = d - 2
mjunan = m
If djunan < 1 Then
mjunan = 3
djunan = djunan + 31
End If

dshouten = d + 39
mshouten = m
Do While (dshouten > 31 And mshouten = 3) Or (dshouten > 30 And mshouten = 4) Or (dshouten > 31 And mshouten = 5) Or (dshouten > 30 And mshouten = 6)

mshouten = mshouten + 1
If mshouten = 4 Or mshouten = 6 Then

dshouten = dshouten - 31
ElseIf mshouten = 5 Or mshouten = 7 Then

dshouten = dshouten - 30
End If



Loop

dpen = d + 49
mpen = m
Do While (dpen > 31 And mpen = 3) Or (dpen > 30 And mpen = 4) Or (dpen > 31 And mpen = 5) Or (dpen > 30 And mpen = 6)

mpen = mpen + 1
If mpen = 4 Or mpen = 6 Then
dpen = dpen - 31
ElseIf mpen = 5 Or mpen = 7 Then
dpen = dpen - 30
End If

Loop



Range("A" & x + 5 - y1).Value = x & "年"
Range("B" & x + 5 - y1).Value = mhai & "月" & dhai & "日"
Range("C" & x + 5 - y1).Value = mjunan & "月" & djunan & "日"
Range("D" & x + 5 - y1).Value = m & "月" & d & "日"
Range("E" & x + 5 - y1).Value = mshouten & "月" & dshouten & "日"
Range("F" & x + 5 - y1).Value = mpen & "月" & dpen & "日"

Next



End Sub
Sub すべて消す()
ActiveSheet.Cells.Clear
End Sub