« 配列をソートする | トップページ | 年間予定表を作成する »

2011年1月 8日 (土)

友愛数

先日テレビで放送されていた映画
『博士が愛した数式』を見ていたら
友愛数というものが出てきました。

この友愛数をVBAで求めてみました。

映画自体は良かったです。

記憶が80分しか持たない博士。
嫌なことは覚えなくて済むと思いきや、
毎朝、記憶が80分しかもたないことに
一人絶望していた。
といった対比がよかったです。

博士のヌボーとした表情に
とてもリアリティーを感じていたのですが、
映画『亡国のイージス』が数日後テレビで放映されていたので
見ていたら
博士役だった寺尾聰が出ていて同じ表情だったので
ちょっとがっかりしました。

さて、友愛数についての説明です。

2つの自然数m, nについて
mのm自身除いた約数の和がn
nのn自身除いた約数の和がmであるとき
mとnを友愛数と呼ぶ。

たとえば、
220 : 1+2+4+5+10+11+20+22+44+55+110 = 284
284 : 1+2+4+71+142 = 220

コードはこちら

友愛数を求めるコード:

Sub macro110108a()
'友愛数を求める

    Sheets.Add
    Cells(1, 1) = "友愛数"
   
    Dim i As Long, j As Long
    Dim c As Object
    Dim i_divsum As Long
    Dim i_divsum2 As Long
   
    For i = 2 To 10 ^ 5
   
        '既に同じ組み合わせが出ていたら次のiへ
        If TypeName(Columns("B").Find(i)) <> "Nothing" Then
            For Each c In Columns("B").Find(i)
                If c = i Then
                    GoTo Next_i
                End If
            Next c
        End If
       
        i_divsum = 0
        i_divsum2 = 0
        'iの自身を除いた約数の和を求める
        For j = 1 To i - 1
            If i Mod j = 0 Then
                i_divsum = i_divsum + j
            End If
        Next j
       
        'i_divsumの自身を除いた約数の和を求める
        For j = 1 To i_divsum - 1
            If i_divsum Mod j = 0 Then
                i_divsum2 = i_divsum2 + j
            End If
        Next j
       
        If i = i_divsum2 Then
            If i <> i_divsum Then '完全数を排除
                'iとi_divsumは友愛数
                Rows(2).Insert
                Cells(2, 1) = i
                Cells(2, 2) = i_divsum
            End If
        End If
Next_i:
    Next i
   
End Sub

macro110108a実行後のシート
Vba20110108a

10万まで調べるには結構時間が掛かります。

重複を避けるところでFind関数を使ったのですが、
Find関数は数字の検索をするのには向いていないのでしょうか?

たとえば、284という数が入っているセルは
"28"で検索に引っ掛かります。
文字列扱いです。

文字列にしても「完全一致検索」は
Find関数だけではできないようですね。

|

« 配列をソートする | トップページ | 年間予定表を作成する »

コメント

この記事へのコメントは終了しました。

トラックバック


この記事へのトラックバック一覧です: 友愛数:

« 配列をソートする | トップページ | 年間予定表を作成する »