今回は完全数です。
実はこの一連の数学プログラミングは、完全数を探してみたくて始めたものです。6, 28, 496, 8128くらいはすぐ見つかりました。数字が大きくなると計算時間がかかるので、なかなか見つからないです。
ソースコードは、ご自由にご利用ください。ただし、趣味のプログラムなので、保証はありません。
Option Explicit
'完全数を調べる
Public Sub Macro()
Dim i As Long
For i = 1 To 100
Sheet1.Cells(i, 1) = i
If isPerfect(i) Then
Sheet1.Cells(i, 2) = "Perfect"
End If
Next i
End Sub
Public Function isPerfect(x As Long) As Boolean
Dim i As Long
Dim sum As Long
isPerfect = False
sum = 0
For i = 1 To x - 1
If x Mod i = 0 Then
sum = sum + i
End If
Next i
If sum = x Then
isPerfect = True
End If
End Function
0 件のコメント:
コメントを投稿