今年2018年は7から18の自乗和らしいので、自乗和から11乗和までの間で、似たような現象がこの先いつあるか調べてみた（最終版）

埼玉まで横浜マリノスの試合を観に行って、敗北にトボトボと帰宅した昨日元旦でした。
とはいえ、決勝まで楽しめたので良しとします。

昨日、元旦の朝、思いつきで書いたマクロについて。
2018は7から18までの連続した整数の自乗和らしいので、似たような現象がこの先いつあるか調べてみた-前編
2018は7から18までの連続した整数の自乗和らしいので、似たような現象がこの先いつあるか調べてみた-完全版

埼玉スタジアムに向かう列車の中で、「もう少し拡大して、3乗以降も調査できるものに改変してみよう」と思った。

前回までの記事で紹介したマクロではForNext構文を使ってくり返し回数を最初から制限したが、DoLoopになおして、所定の条件を満たす年に至るまでは作業継続、とすればよい。
自乗、三乗、四乗、…と調査していくとして、ではどこまで？というのも、同様に、最初の演算の結果が調査範囲の年を超えないか？というところで制約する。

ということで、今朝から書き直し。
ついでに結果出力先シートの初期化のこととか、調査対象範囲を2018年より前でも自由に設定できるようにとか、さらについでだから、調査対象範囲のはじまりと終わりが逆だったら警告して終了しよう、とか、いろいろ追加勘案しつつ、整理しつつ、として作ったマクロが以下。

Option Explicit

Const C_FM As Long = 2018
Const C_TO As Long = 2330
Const S_RBASE As String = "A3"

Dim cTo As Long
Public Sub main()
    ThisWorkbook.Activate
    If C_FM >= C_TO Then
        MsgBox "調査開始年度C_FMは調査終了年度C_TOより小さい値でなくてはなりません。"
        Exit Sub
    End If
    
    Dim c As Long
    Dim rTo As Range
    Maeshori rTo
    
    c = 2
    cTo = 1
    Do While 2 ^ c <= C_TO
        Kaiseki rTo, c
        c = c + 1
    Loop
    
    Atoshori rTo
End Sub
Private Sub Maeshori(rN As Range)
    Dim w As Worksheet, wN As Worksheet
    Dim b As Boolean
    Const W_NAME As String = "Result"
    b = False
    
    Set wN = Worksheets.Add
    With wN
        Application.DisplayAlerts = False
        For Each w In Worksheets
            If w.Name <> .Name Then
                w.Delete
            End If
        Next
        Application.DisplayAlerts = True
        
        .Name = W_NAME
        Set rN = .Range(S_RBASE)
        .Range("A1").Value = "西暦" & C_FM & "年から" & C_TO & "年までの主なイベント"
    End With
    
    With rN
        .Offset(, 0).Value = "ID"
        .Offset(, 1).Value = "条件1"
        .Offset(, 2).Value = "条件2"
        .Offset(, 3).Value = "条件3"
        .Offset(, 4).Value = "計算値"
        .Offset(, 5).Value = "計算式"
        .Offset(, 1).EntireColumn.NumberFormatLocal = "0_ ""から"""
        .Offset(, 2).EntireColumn.NumberFormatLocal = "0_ ""乗を"""
        .Offset(, 3).EntireColumn.NumberFormatLocal = "0_ ""個連続"""
        .Offset(, 5).EntireColumn.NumberFormatLocal = "@"
        Range(.Offset(, 1), .Offset(, 3)).EntireColumn.HorizontalAlignment = xlRight
        Range(.Offset(, 0), .Offset(, 5)).HorizontalAlignment = xlCenter
    End With
End Sub
Private Sub Kaiseki(rTo As Range, n As Long)
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = n & "乗数の連続和"
    
    Dim rB As Range
    Set rB = ActiveSheet.Range("A1")
    
    Dim cYoko As Long, cTate As Long
    Dim cnt As Long, cSum As Long
    Dim sSk As String, cSk As Long
    cYoko = 1 '2
    cTate = 1
    With rB
        Do
            .Offset(, cYoko).Value = cYoko & "個連続"
            Do
                cSum = 0
                For cnt = cTate To cTate + cYoko - 1
                    cSum = cSum + cnt ^ n
                Next
                .Offset(cTate, cYoko).Value = cSum
                If cSum >= C_FM And cSum <= C_TO Then
                    With .Offset(cTate, cYoko).Font
                        If cSum < Year(Date) Then
                            .Color = vbBlue
                        Else
                            .Color = vbRed
                        End If
                        .Bold = True
                    End With
                    With rTo
                        .Offset(cTo, 0).Value = cTo
                        .Offset(cTo, 1).Value = cTate
                        .Offset(cTo, 2).Value = n
                        .Offset(cTo, 3).Value = cYoko
                        .Offset(cTo, 4).Value = cSum
                        sSk = ""
                        For cSk = 1 To cYoko
                            sSk = sSk & " + " & (cTate + cSk - 1) & "^" & n
                        Next
                        .Offset(cTo, 5).Value = "=" & Mid(sSk, 3)
                    End With
                    cTo = cTo + 1
                End If
                cTate = cTate + 1
            Loop While cSum < C_TO
            
            If cTate = 2 Then
                Exit Do
            End If
            
            cTate = 1
            cYoko = cYoko + 1
        Loop
        
        .Offset(, 0).Value = "整数"
        .Offset(, 1).Value = "累乗値"
        For cTate = 2 To .CurrentRegion.Rows.Count
            .Offset(cTate - 1, 0).Value = cTate - 1
        Next
    End With
End Sub
Private Function Rep(r As Range) As String
    Dim s As String
    If IsNumeric(r.Value) Then
        If r.Value < 10 Then
            s = " "
        End If
    End If
    Rep = s & Replace(r.Text, " ", "") & " "
End Function
Private Sub Atoshori(rN As Range)
    With rN
        .CurrentRegion.Sort _
            Key1:=.Offset(, 4), Order1:=xlAscending, _
            Key2:=.Offset(, 2), Order2:=xlAscending, _
            Header:=xlYes
        Range(.Offset(, 1), .Offset(, 4)).ColumnWidth = 9.27
        .Offset(, 5).EntireColumn.AutoFit
        
        Dim s As String, c As Long, d As Long
        For c = 1 To .CurrentRegion.Rows.Count - 1
            s = ""
            For d = 1 To 5
                s = s & Rep(.Offset(c, d))
            Next
            Debug.Print s
        Next
        .Worksheet.Activate
    End With
End Sub

配列使ってないけど引数つきプロシージャ使っているから、ウチの講座で言うと「エクセルマクロ・VBA発展編２」レベル。
そこだけ無視したら、「エクセルマクロ・VBA発展編１」の受講生でもまあ理解可能かも。

出力結果は、以下。今年に近い順に並べた。

【結果】
 7から  2乗を 12個連続 2018 =7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
 2から  3乗を  8個連続 2024 =2^3+3^3+4^3+5^3+6^3+7^3+8^3+9^3 
45から  2乗を  1個連続 2025 =45^2 
 1から  3乗を  9個連続 2025 =1^3+2^3+3^3+4^3+5^3+6^3+7^3+8^3+9^3 
25から  2乗を  3個連続 2030 =25^2+26^2+27^2 
21から  2乗を  4個連続 2030 =21^2+22^2+23^2+24^2 
 2から 11乗を  1個連続 2048 =2^11 
 1から 11乗を  2個連続 2049 =1^11+2^11 
14から  2乗を  7個連続 2051 =14^2+15^2+16^2+17^2+18^2+19^2+20^2 
 6から  2乗を 13個連続 2054 =6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
16から  2乗を  6個連続 2071 =16^2+17^2+18^2+19^2+20^2+21^2 
 5から  2乗を 14個連続 2079 =5^2+6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
11から  2乗を  9個連続 2085 =11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2+19^2 
 4から  2乗を 15個連続 2095 =4^2+5^2+6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
 3から  2乗を 16個連続 2104 =3^2+4^2+5^2+6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
 2から  2乗を 17個連続 2108 =2^2+3^2+4^2+5^2+6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
 1から  2乗を 18個連続 2109 =1^2+2^2+3^2+4^2+5^2+6^2+7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
32から  2乗を  2個連続 2113 =32^2+33^2 
46から  2乗を  1個連続 2116 =46^2 
 4から  4乗を  3個連続 2177 =4^4+5^4+6^4 
10から  2乗を 10個連続 2185 =10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2+19^2 
 3から  7乗を  1個連続 2187 =3^7 
26から  2乗を  3個連続 2189 =26^2+27^2+28^2 
13から  3乗を  1個連続 2197 =13^3 
47から  2乗を  1個連続 2209 =47^2 
22から  2乗を  4個連続 2214 =22^2+23^2+24^2+25^2 
19から  2乗を  5個連続 2215 =19^2+20^2+21^2+22^2+23^2 
13から  2乗を  8個連続 2220 =13^2+14^2+15^2+16^2+17^2+18^2+19^2+20^2 
 8から  3乗を  3個連続 2241 =8^3+9^3+10^3 
33から  2乗を  2個連続 2245 =33^2+34^2 
 3から  4乗を  4個連続 2258 =3^4+4^4+5^4+6^4 
 9から  2乗を 11個連続 2266 =9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2+19^2 
 2から  4乗を  5個連続 2274 =2^4+3^4+4^4+5^4+6^4 
 1から  4乗を  6個連続 2275 =1^4+2^4+3^4+4^4+5^4+6^4 
15から  2乗を  7個連続 2296 =15^2+16^2+17^2+18^2+19^2+20^2+21^2 
17から  2乗を  6個連続 2299 =17^2+18^2+19^2+20^2+21^2+22^2 
48から  2乗を  1個連続 2304 =48^2 
 2から  7乗を  2個連続 2315 =2^7+3^7 
 1から  7乗を  3個連続 2316 =1^7+2^7+3^7 
 8から  2乗を 12個連続 2330 =8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2+19^2 

興味深いのは、2025年と2030年。
それぞれ、別の連続した数値の自乗和または三乗和で表現できる。

2025年:
= 45^2
= 1^3 + 2^3 + 3^3 + 4^3 + 5^3 + 6^3 + 7^3 + 8^3 + 9^3

2030年:
= 25^2 + 26^2 + 27^2
= 21^2 + 22^2 + 23^2 + 24^2

なんかひょっとしたら「式を変形すると簡単にもうひとつの式になる」とかなのかもしれないけど、僕は数学苦手なんで、ツッコミはこのくらいでやめておきます。
誰かよかったら教えてください。

2113年の「32の2乗 + 33の2乗、」2177年の「4の4乗 x 5の4乗 x 6の4乗」、2187年の「3の7乗」もなかなかアツい。

1900年から今年までを調べるとこんな↓感じ。(ソース2-3行目の C_FM, C_TO の値を変えてマクロ再実行)

【結果】
 9から  2乗を 10個連続 1905 =9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
 5から  4乗を  2個連続 1921 =5^4+6^4 
 5から  3乗を  5個連続 1925 =5^3+6^3+7^3+8^3+9^3 
44から  2乗を  1個連続 1936 =44^2 
12から  2乗を  8個連続 1964 =12^2+13^2+14^2+15^2+16^2+17^2+18^2+19^2 
 8から  2乗を 11個連続 1969 =8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 
31から  2乗を  2個連続 1985 =31^2+32^2 
 4から  3乗を  6個連続 1989 =4^3+5^3+6^3+7^3+8^3+9^3 
18から  2乗を  5個連続 2010 =18^2+19^2+20^2+21^2+22^2 
 3から  3乗を  7個連続 2016 =3^3+4^3+5^3+6^3+7^3+8^3+9^3 
 7から  2乗を 12個連続 2018 =7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2 

1905 =9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2
1969 =8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2

は、

2018 =7^2+8^2+9^2+10^2+11^2+12^2+13^2+14^2+15^2+16^2+17^2+18^2

の前駆体のようなものですな。

試みに範囲を西暦10,000年までにして調べてみたところ、西暦9944年は、「= 17^2 + 18^2 + 19^2 + 20^2 + 21^2 + 22^2 + 23^2 + 24^2 + 25^2 + 26^2 + 27^2 + 28^2 + 29^2 + 30^2 + 31^2 + 32^2」だそうですw
あと、西暦9955年が「= 1^2 + 2^2 + 3^2 + 4^2 + 5^2 + 6^2 + 7^2 + 8^2 + 9^2 + 10^2 + 11^2 + 12^2 + 13^2 + 14^2 + 15^2 + 16^2 + 17^2 + 18^2 + 19^2 + 20^2 + 21^2 + 22^2 + 23^2 + 24^2 + 25^2 + 26^2 + 27^2 + 28^2 + 29^2 + 30^2」これが最強。
4乗を8個ならべる西暦8772年「= 1^4 + 2^4 + 3^4 + 4^4 + 5^4 + 6^4 + 7^4 + 8^4」も、訳もなくロマンを感じないこともない。

---

あとは、調べようと思ったら、「素数の足し算で表現できる年」とかなんとかいろいろ考えられるんだろうけど、もう気が済んだのでこれでおしまい。
「任意の素数の和」くらいだと「累乗の和として表現できるものすべて調査」と比べて課題が簡単すぎるし。

ソース入りエクセルファイルさしあげます。このリンクからどうぞ。(.zipファイル)

関連リンク:
2018は7から18までの連続した整数の自乗和らしいので、似たような現象がこの先いつあるか調べてみた-前編
2018は7から18までの連続した整数の自乗和らしいので、似たような現象がこの先いつあるか調べてみた-完全版