以下に処理の流れとプログラムを記します。プログラムと照らし合わせて読んでください。
約数とは、「因数を掛け合わせたもの」ですよね？
だからまず因数を求める関数を作成しました。(関数：subFactorization)
そのとき注意すべきは
１０の因数を求めるのには５まで、７の因数を求めるには４までに因数がないときはそれ以上の値に因数は存在しないという点です。なので途中でそのリミットになったら抜ける条件を追加しました。(変数：lngRimitがそれにあたります。)
次にその因数を掛け合わすために、その因数を順順に取り出す関数を作成しました。（関数：subMultiplyMatrix）
実際に例をあげると最初に２１０を因数分解した場合
３，５，７という値が得られます。これらを掛け合わせるとき
３
５
７
３×５
３×７
５×７
３×５×７
という７パターンがあります。
この７パターンの値を配列に収めるようなループが必要でした。（プログラム中のi,jを使用してループしてるのがその部分です）
次にその配列内の値を乗算する関数を作成しました。(関数：subMultiplyMatrix)
しかし、これだけではだめでした。
２１０だから因数は[３，５，７]だけど、１２のときは[２，２，３]という値を得ます。この条件でできるパターンは
２
２
３
２×２
２×３
２×２
２×２×３
となり、重複する値が返ってきます。これではこまります。
なので答えを収める変数をコレクションで宣言し、値のセットをするときに"KEY"という文字列と値を組み合わせたKEYを同時にセットし、重複した値を記憶しないようにしました。(KEY
& wkLng となってる部分です。)
ちなみにOn Error Resume Next
というのが書いてありますが、これがないと、「重複したキーが存在する」というエラーが生じます。
あとは単なるメッセージボックスに出力をしてるだけです。環境を特に書いてなかったので、Join関数を使用してます。VB6限定ですが、大丈夫かな？
以上が処理の流れです。
いやーホント勉強になりました。
以下のソースを貼り付けて見てください。
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long _
)
Private lngAry() As Long '因数記憶用の配列
Private lngCnt As Long '因数のカウンタ
Sub Main()
Dim lngDef As Long '初期値
Dim ansCollection As Collection '答えの入るコレクション
Dim i As Long
'初期値を得る
On Error GoTo PGMERR
lngDef = InputBox("", "初期値を入力してください")
On Error GoTo 0
'初期値が１未満をエラーとします
If lngDef < 1 Then GoTo PGMERR
'因数カウンタの初期化
lngCnt = 0
'因数記憶用の配列を初期化
Erase lngAry
'因数分解をする
Call subFactorization(lngDef)
'コレクションを初期化
Set ansCollection = New Collection
'とりあえず１を追加
ansCollection.Add 1, "KEY1"
'配列の中身を順に掛け合わせ、コレクションに追加する
Call subMultiplyMatrix(lngAry, ansCollection)
'答えの出力
Call ansOut(ansCollection)
PGMEND:
Exit Sub
PGMERR:
Call MsgBox("初期値に不正な値が入力されました")
End Sub
'因数分解
Sub subFactorization(inLng As Long)
Dim i As Long
Dim lngRimit As Long
'中間の値を求める（切り上げ）
lngRimit = Int((inLng / 2 * 10 + 9) / 10)
For i = 2 To inLng
'割ってあまり０のとき、因数とする
If (inLng Mod i) = 0 Then
'因数を記憶
ReDim Preserve lngAry(lngCnt) As Long
lngAry(lngCnt) = i
'因数のカウンタを増やす
lngCnt = lngCnt + 1
'因数で割った値でさらに因数分解
Call subFactorization((inLng / i))
Exit For
End If
'中間の値になっても因数が見つからないとき、引数自身が因数とする
If i >= lngRimit Then
'因数を記憶
ReDim Preserve lngAry(lngCnt) As Long
lngAry(lngCnt) = inLng
'因数のカウンタを増やす
lngCnt = lngCnt + 1
Exit For
End If
Next i
End Sub
'掛け算マトリックス
Sub subMultiplyMatrix(inlngAry() As Long, inColection As Collection)
Dim wklngAry() As Long
Dim i As Long
Dim j As Long
Dim wkLng As Long
'因数に同じ値が存在するときに発生するエラーを無視させる
On Error Resume Next
For i = 0 To lngCnt - 1
For j = 0 To (lngCnt - 1) - i
Call copyAry(wklngAry, inlngAry(j), i + 1)
wkLng = subMultiply(wklngAry)
inColection.Add wkLng, "KEY" & wkLng
Next j
Next i
On Error GoTo 0
End Sub
'配列の中身を掛け算して値を返す関数
Function subMultiply(inlngAry() As Long)
Dim i As Long
subMultiply = inlngAry(0)
For i = LBound(inlngAry) + 1 To UBound(inlngAry)
subMultiply = subMultiply * inlngAry(i)
Next i
End Function
'配列の中身をエリアの分だけコピーする関数
Sub copyAry(inDest() As Long, inSrc As Long, inArea As Long)
ReDim inDest(inArea - 1) As Long
Call CopyMemory(inDest(0), ByVal VarPtr(inSrc), ByVal LenB(inSrc) *
inArea)
End Sub
'答えの出力
Sub ansOut(inCollection As Collection)
Dim wkStr As String
Dim ansCount As Long
Dim wkStrAry() As String
Dim i As Long
ansCount = inCollection.Count
ReDim wkStrAry(ansCount - 1) As String
For i = 1 To ansCount
wkStrAry(i - 1) = inCollection.Item(i)
Next i
wkStr = "答えは[" & Join(wkStrAry, ",") & "]です"
MsgBox wkStr
End Sub
お礼
ありがとうございました。助かります。