当サイトではアフィリエイトプログラムを利用して商品を紹介しています。

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

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

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

Excel 五角数
五角数の逆数の無限和
\[\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) があります。

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

Excel 数字の塗り分け
このとき、セル範囲を選択して実行すると、範囲の中に含まれている数字を合計する 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 となります。

エクセルや数学に関するコメントをお寄せください