| |
▼りん さん：
ヒロさん、こんばんは。
>>abcdef のすべての組み合わせをエクセルのシートに出力
>>するようなプログラムがわかる方教えてください。
↑という内容だったので・・・・
>このツリーが参考になりませんか？
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=5435;id=excel
↑参考にして頂ければいいかな？と思ったのですが、
>例 abcの時
>出力結果
> abc
> acb
> bca
> bac
> dac
> dca
これって、組み合わせじゃなくて、順列ですよね？
前回、組み合わせを作ったんで、「これで順列作っとけば何かのときに使えるかな」と
思っていたんでキッカケができてよかったです。
例題は、セルＡ１、Ｂ１、Ｃ１に"a","b","c"と入っていたとき、
Ａ列の3行目からリストを出力するコードです。
'==========================================================
Sub test()
Dim ans()
Dim 抜き取り As Long
抜き取り = 3
permt = permut_sp(ans(), Range("a1:c1"), 抜き取り)
Range(Cells(3, 1), Cells(permt + 2, 抜き取り)).Value = ans()
MsgBox "以上" & permt & "通りのリストです"
End Sub
'===============================================================
Function permut_sp(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(): 順列リスト
' permut_sp:順列数
' 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
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
gyou = WorksheetFunction.Permut(rng.Count, seln)
permut_sp = gyou
ReDim ans(1 To gyou, 1 To svn)
ctx = 1
idx = 1
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
Do While myx <= mylim
retcode = 0
For i = 1 To ctx - 1
If ans(idx, i) = myarray(myx) Then
retcode = 1
End If
Next
If retcode = 0 Then Exit Do
myx = myx + 1
Loop
If myx > mylim Then Exit Do
ans(idx, ctx) = myarray(myx)
If ctx + 1 <= svn Then
Call permut_sp(ans(), , , 1, ctx + 1)
End If
myx = myx + 1
idx = idx + 1
cnt = cnt + 1
Loop
idx = idx - 1
End Function
以上ですが、もしかしたら、一つのセルに"abc"と入れたかったですか？
|
|
ichinose
- 03/5/19(月) 23:37 -
