| |
▼さくら さん：
こんばんは。
さくらさんの意図した結果ではなかったみたいですが、Function combの引数の変更でいけますよね？
で、combの中身の説明ですが、コード見ておわかりだと思いますが、リカーシブルになっています。本当は、なるべくこういうコードは書かないようにしているのですが（非常にメンテナンスしづらいですよね、ちょっと前まで北朝鮮拉致ドラマ見てウルウルしてたらもう自分でもコード解析が大変です）、第1印象でこれしかないだろうと思ってしまったもので・・・。
コメントを付けようかと思いましたが、付けても説明がわかりづらいだろうと思いましたので、コードの考え方だけ。
仮に組み合わせのメンバーを
1 2 3 4 5とし、
抜き取り数を3と限定しましょう。
1列 2列 3列
1 2 3
1 2 4
1 2 5
1 3 4
1 3 5
1 4 5
2 3 4
2 3 5
2 4 5
3 4 5
組み合わせリストは上記の10通りになりますが、
規則性として、各行とも1列<2列<3列 となっていますよね。
よって、配列の引数はこの条件を満たしながら変化させ、各列の値をひとつづつ変化させるロジックを考えました。
'=====================================================================
Function comb(ans(), Optional rng As Range = Nothing, Optional seln As Long = 0, Optional ByVal myx As Long = 0, Optional ByVal ctx As Long = 0) As Long
'input rng : 組み合わせメンバーセル範囲
' seln: 抜き取り数
'out ans() 組み合わせリスト
‘ comb 組み合わせ総数
' mxy ctx は 内部パラメータ指定不可
Dim crng As Range
Static svn As Long
Static myarray()
Static idx As Long
Static gyou As Long
Static mylim As Long
Dim cnt As Long
If seln > 0 Then
‘最初に呼び出されたときの初期設定を行います
‘リカーシブルによる2回目以降には実行されません
svn = seln
Erase myarray
i = 1
For Each crng In rng
ReDim Preserve myarray(1 To i)
myarray(i) = crng.Value
i = i + 1
Next
‘このループで組み合わせ要素を１次元の配列に移行しています
mylim = rng.Count
myx = 1 ‘myarrayのインデックス
gyou = WorksheetFunction.Combin(rng.Count, seln) ‘組み合わせ数の算出
comb = gyou
ReDim ans(1 To gyou, 1 To svn) ‘組み合わせリストのエリア確保
ctx = 1 ‘配列ansの列のインデックス
idx = 1 ‘‘配列ansの行のインデックス
End If
cnt = 0
Do While myx <= mylim And idx <= gyou
If cnt > 0 And idx > 1 Then
For i = 1 To ctx - 1
ans(idx, i) = ans(idx - 1, i)
Next
End If
‘↑のループで当該列の直前までの列の要素をコピー
ans(idx, ctx) = myarray(myx)
‘↑このコードをループさせることで一つの列を配置を完成させていきます
If ctx + 1 <= svn Then ‘抜き取り数に達していなければ、リカーシブルコール
Call comb(ans(), , , myx + 1, ctx + 1)
End If
myx = myx + 1
idx = idx + 1
cnt = cnt + 1
Loop
idx = idx - 1
End Function
前述したようにコメントも付けにくいし、付けてもわかりづらいと思いますが・・。
|
|
ichinose
- 03/5/15(木) 0:39 -
