【VBA】五角数の逆数の無限和

【VBA12】五角数の逆数の無限和

正五角形状に並べた点の総数を 五角数 (pentagonal number) とよびます。五角数は $1$ から小さい順に
\[1,\ 5,\ 12,\ 22,\ 35,\ 51,\ 70,\ 92, ……\]
のように並び、一般に $n$ 番目の五角数は
\[P_n=\frac{n(3n-1)}{2}\]
で与えられます。下図は $5$ 番目の五角数なので、点の総数を数えると $35$ 個あります。


五角数の逆数の無限和 は
\[\sum_{n=1}^{\infty}\frac{1}{P_n}=1.4820375 …\]
という値に収束することが知られています。引数に k を与えると第 k 項までの五角数の逆数和を返す Functionマクロをつくって上の事実を確認してください。ただし、コンピュータでは無限に加算することはできないので、求めた値が 1.4819 を超えたら正解とします。

【ヒント】ループ処理で逆数を順に足していくだけですが、あまり大きな k を与えるとオーバーフローしてしまいます。問題で要求される精度の値が出力されるような k を探してください。
　
【解答】五角数の逆数和
\[\sum_{n=1}^{k}P_n=\sum_{n=1}^{k}\frac{2}{n(3n-1)}\]
を計算する Function プロシージャを記述します。関数名 RPentagonalSum の R は reciprocal (逆数) を意味しています。

'五角数の逆数和
Function R_Pentagonal_Sum(k As Long) As Double
　　Dim n As Long
　　Dim s As Double
　　For n = 1 To k
　　　　s = s + 2 / (n * (3 * n - 1))
　　Next n
　　RPentagonalSum = s
End Function

k = 10000 で十分な精度が得られます。ワークシートのセルに

=R_Pentagonal_Sum(10000)

と入力すると、1.481970837 という値が返ります。ChatGPT による解答も以下に載せておきます。

'五角数の逆数和(ChatGPT)

Function SumOfInversePentagonalNumbers(k As Integer) As Double
    Dim result As Double
    Dim i As Integer
    
    For i = 1 To k
        result = result + 1 / PentagonalNumber(i)
    Next i
    
    SumOfInversePentagonalNumbers = result
End Function

Function PentagonalNumber(n As Integer) As Double
    PentagonalNumber = (3 * n * n - n) / 2
End Function

Sub Test()
    Dim k As Integer
    k = 10 ' 任意の項数を指定
    
    Dim sum As Double
    sum = SumOfInversePentagonalNumbers(k)
    
    MsgBox "五角数の逆数の無限和（" & k & "項まで）: " & sum
End Sub

【VBA13】黄色は加算、青色は減算

Excel の [塗り潰しの色] 一覧の下の方に [標準の色] が並んでいますが、その中に黄色 (ColorIndex = 6) と薄い青 (ColorIndex = 33) があります。


たとえば、下の図のように数字の入ったセルを黄色と薄い青で塗り分けて、黄色のセルの数字は正の値、薄い青のセルの数字は負の値を表すものとします。


このとき、セル範囲を選択して実行すると、範囲の中に含まれている数字を合計する Subプロシージャをつくってください。ただし、何も塗られていない数字は無視するものとします。

【ヒント】・セル範囲を格納する変数は Range 型です。
・セルの背景色は Interior.ColorIndex プロパティで取得します。
・セル範囲に対してループさせるための VBA 特有の構文があります。
　
【解答】
[1] 合計値を格納するための変数 s を Double型で宣言します。

[2] セル範囲を格納するための変数 r を Range型で宣言しておきます。

[3] 現在選択されているセル範囲は Selectionプロパティで取得することができます。Selectionプロパティは Applicationオブジェクトに属しているので、Selection 単独の記述でオブジェクトを取得できます。もちろん敢えて Application.Selection と書いても構いません。

[4] For Each … Next ステートメントで選択範囲にあるセルすべてについて背景色を調べて、黄色であるならばセルの数値を s に加え、薄い青色であるならば s から差し引きます。

'黄色のセルの数値を加算、薄い青色セルの数値を減算
Sub COLOR_SUM()
　　Dim s As Double
　　Dim r As Range
　　'選択範囲のすべてのセルについて処理
　　For Each r In Selection
　　　　'セルの背景色が黄色である場合
　　　　If r.Interior.ColorIndex = 6 Then
　　　　　　s = s + r.Value
　　　　'セルの背景色が薄い青色である場合
　　　　ElseIf r.Interior.ColorIndex = 33 Then
　　　　　　s = s - r.Value
　　　　End If
　　Next
　　Debug.Print s
End Sub

COLOR_SUM() を実行するとイミディエイトウィンドウに合計値が表示されます。
上の図にあるサンプルワークシートで実行すると合計値は 5 となります。