【VBA】数字和（digit sum）を返す関数

【VBA09】数字和を返す関数

自然数の各桁の数字を足し合わせた数を 数字和（digit sum）とよびます。たとえば 3159 の数字和は「3 + 1 + 5 + 9 = 18」となります。任意の自然数を引数に渡すと数字和を返す Function プロシージャ（ユーザー定義関数）をつくってください。関数の名前は DigitSum とします。

【ヒント】数字和を求めるには、渡された数字の桁数を取得して、さらに各桁の数字を取り出すという処理が必要です。VBA で「取り出す」といえば、あの関数です。
　
【解答】文字数を取得する Len 関数を使って、引数に受け取った数字 n の桁数を調べることができます。Len 関数の引数には文字列を指定することなっていますが、数値を入力しても自動的に文字列型に変換されるので問題ありません。ただし引数の型は宣言しないように（つまり Variant型に）しておく必要があります。

ある文字列から特定の文字を取り出すときは Mid 関数を使います。

Mid(文字列, 開始位置, [取り出す文字の長さ])

たとえば、n の k 番目から 1 文字を取り出すには

Mid(n, k, 1)

と記述します。k をループ変数として 1 から Len(n) まで取り出して足し合わせれば数字和を得ることができます。

'VBA-09 解答コード

'桁を加算する関数
Function DigitSum(n) As Long

　　Dim k As Long, s As Long

　　For k = 1 To Len(n)
　　　s = s + Mid(n, k, 1)
　　Next k

　　DigitSum = s

End Function

ワークシートのセルに

=DigitSum(1234)

と入力すると 10 が返ってきます。VBE のイミディエイトウィンドウで確認する場合は次のコードを入力してください。

Sub DisigSumTest()
　　Debug.Print DigitSum(1234)
End Sub

ChatGPT に解答してもらったところ、次のような見事なコードを書いてくれました。私のなんかより断然いいので、ぜひ見習ってください。

'VBA-09 解答コード(ChatGPT)

'受け取った数値の各桁を加算する関数
Function SumDigits(number As Long) As Long
    Dim sum As Long
    sum = 0
    
    ' 各桁の数字を足し合わせる
    Do While number > 0
        ' 数字の一の位を取得して足し合わせる
        sum = sum + number Mod 10
        ' 取得した一の位を除去して次の桁に進む
        number = number \ 10
    Loop
    
    ' 合計値を返す
    SumDigits = sum
End Function

【VBA10】各桁を 3 乗した数の和がもとの数と等しくなる数

(1) 1000 以下の自然数で、各桁を n 乗した数の和がもとの数と等しくなる数を出力する Functionプロシージャ（ユーザー定義関数）をつくってください。関数名は DigitPowerSum とします。

(2) 各桁を 3 乗した数の和がもとの数と等しくなるような 1000 以下の自然数をすべて求めてください。

【ヒント】VBA-09 の類題です。(1) は VBA09 のコードに少し手を加えるだけです。(2) では (1) で作った DigitPowerSum関数を使います。
　
【解答】(1) 引数 x, n を受け取って、x の各桁を取り出して n 乗した数を足し合わせていきます。

'VBA-10 (1) 解答コード

'各桁の n 乗を加算する関数
Function DigitPowerSum(x, n As Long) As Long

　　Dim k As Long, s As Long

　　For k = 1 To Len(x)
　　　　s = s + Mid(x, k, 1) ^ n
　　Next k

　　DigitPowerSum = s

End Function

(2) 1 から 1000 までの数 k を DigitPowerSum(k, 3) と比較して、一致していれば表示するようなプログラムを書きます。

'VBA-10 (2) 解答コード

'各桁を3乗した数の和がもとの数と等しくなる数の探索
Sub EqDPS()

　　Dim k As Long

　　For k = 1 To 1000
　　　　If k = DigitPowerSum(k, 3) Then
　　　　　　Debug.Print k;
　　　　End If
　　Next k

End Sub
'EqDPSの実行結果：
'1　153　370　371　407

念のために確認しておくと、

1³ = 1
1³ + 5³ + 3³ = 1 + 125 + 27 = 153
3³ + 7³ + 0³ = 27 + 343 + 0 = 370
3³ + 7³ + 1³ = 27 + 343 + 1 = 371
4³ + 0³ + 7³ = 64 + 0 + 343 = 407

となって、確かに条件を満たしていることがわかります。

ちなみに、ChatGPT は (1) と (2) について、次のようなマクロを作成してくれました。

'VBA-10 (1)(2) 解答コード(ChatGPT)

Function FindNarcissisticNumber(n As Integer) As String
    Dim i As Integer
    Dim num As String
    Dim digitSum As Integer
    
    For i = 1 To 1000
        num = CStr(i)
        digitSum = 0
        
        For j = 1 To Len(num)
            digitSum = digitSum + (Mid(num, j, 1) ^ n)
        Next j
        
        If digitSum = i Then
            FindNarcissisticNumber = FindNarcissisticNumber & i & ", "
        End If
    Next i
    
    If Len(FindNarcissisticNumber) > 0 Then
        FindNarcissisticNumber = Left(FindNarcissisticNumber, Len(FindNarcissisticNumber) - 2)
    Else
        FindNarcissisticNumber = "該当する数はありません。"
    End If
End Function

【VBA11】互いに素である組を表示するマクロ

自然数 a, b の最大公約数が 1 であるとき、「a, b は互いに素である」といいます。たとえば、(a, b) = (5, 9) の最大公約数は 1 なので、5 と 9 は互いに素です。1 はすべての自然数と互いに素です。そこでいま、2 < a ≦ 9, 2 b ≦ 9 として、互いに素である (a, b) をすべて表示するマクロをつくってください。ただし、(5, 9) と (9, 5) のような組合せは同じ組を表すので、片方だけを表示させるものとします。

【ヒント】
・ワークシート関数 (Excel関数) のなかに、最大公約数を求める GCD という関数があります。ワークシート関数を VBA で呼び出すときは

WorksheetFunction.関数名(引数1 [, 引数2, ...)

と記述します。

・For … Next を入れ子にすれば、自然数の組 (x, y) を列挙することは簡単ですが、この問題では重複なしで表示することが求められています。変数の使い方に工夫が必要です。
　
【解答】調べる組を (x, y) とおきます。x = 2 のとき、(2, y) において y を x + 1 から 9 まで動かすと、

(2, 3), (2, 4), (2, 5), (2, 6), (2, 7), (2, 8), (2, 9)

という組合せが得られます。最大公約数が 1 となる組合せを選び出して並べると

(2, 3), (2, 5), (2, 7), (2, 9)

となります。

x = 3 のとき、(3, y) において y を x + 1 から 9 まで動かすと、

(3, 4), (3, 5), (3, 6), (3, 7), (3, 8), (3, 9)

という組合せが得られます。最大公約数が 1 となる組合せを選び出して並べると

(3, 4), (3, 5), (3, 7), (3, 8)

となります。以下同様にして、x = 9 まで調べれば、互いに素となる組をすべて見つけることができます。

'VBA-11 解答コード

'互いに素である組の探索
Sub CoPrime()

　　Dim x As Long, y As Long, g As Long

　　For x = 2 To 9

　　　　For y = x + 1 To 9

　　　　　　'x と y の最大公約数
　　　　　　g = WorksheetFunction.Gcd(x, y)

　　　　　　If g = 1 Then
　　　　　　　　Debug.Print "(" & x & ", " & y & "), ";
　　　　　　End If

　　　　Next y

　　Next x

End Sub

'CoPrimeの実行結果：
'(2, 3), (2, 5), (2, 7), (2, 9), (3, 4), (3, 5), (3, 7), (3, 8), (4, 5), (4, 7), (4, 9), (5, 6), (5, 7), (5, 8), (5, 9), (6, 7), (7, 8), (7, 9), (8, 9)

CoPrimeマクロを実行すると互いに素である組が並びます。ChatGPT による解答は以下のようになりました。

'VBA-11 解答コード(ChatGPT)

Sub FindCoprimePairs()
    Dim a As Integer
    Dim b As Integer
    
    For a = 2 To 9
        For b = a To 9 ' bの範囲をa以上に制限することで重複を避ける
            If IsCoprime(a, b) Then
                Debug.Print "(" & a & ", " & b & ")"
            End If
        Next b
    Next a
End Sub

Function IsCoprime(num1 As Integer, num2 As Integer) As Boolean
    Dim smallerNum As Integer
    Dim i As Integer
    
    smallerNum = IIf(num1 < num2, num1, num2)
    
    For i = 2 To smallerNum
        If num1 Mod i = 0 And num2 Mod i = 0 Then
            IsCoprime = False
            Exit Function
        End If
    Next i
    
    IsCoprime = True
End Function