VBAで順列を表現する方法

質問

VBAによる順列の表記の仕方を教えてほしいです。
例えばn個の数値から2つの要素を並べる順列nP2の場合、1番目に選んだ数値が2番目の順列の選択候補から外れ、1番目と2番目の数値を順列として表示するようなVBAを組みたいです。
つまり同じ数字を2回以上使わないnPm(m≧2)という順列を作成したいのです。
どのようなプログラムを組めばよいか教えてください。

回答No.2

lark_0925 · ベストアンサー

新規ブックにて、試してみてください。

標準モジュール（Module1）に

'====================================================================
Sub main()
　　Dim 抜き取り数 As Long
　　Dim ans() As Variant
　　Dim retcode As Long
　　Dim rw As Long
　　Dim cnt As Long
　　cells.clear
　　With Range("a1:g1")
　　　.Formula = "=column()"
　　　.Value = .Value
　　　抜き取り数 = Int(Rnd() * .Count) + 1
　　　MsgBox "a1:g1の値から、 7P" & _
　　　　　　　抜き取り数 & _
　　　　　　　" の順列リストを作成します"
　　End With
　　ReDim ans(1 To 抜き取り数)
　　rw = 3
　　cnt = init_permut(Range("a1:g1"), 抜き取り数)
　　retcode = get_permut(ans())
　　Do While retcode = 0
　　　Range(Cells(rw, 1), Cells(rw, UBound(ans()))).Value = ans()
　　　rw = rw + 1
　　　retcode = get_permut(ans())
　　Loop

　　Call term_permut
　　MsgBox "以上、 " & cnt & " 個のリストを作成しました"

End Sub

別の標準モジュール(Module2）に　順列リスト作成プログラムパック

Option Explicit
　　Private p_svn As Long '抜き取り数保存
　　Private p_myarray() '順列対象値の配列
　　Private p_idx() As Long '配列の各位置のボインタ
'=========================================================================================
Function init_permut(ByVal rng As Range, ByVal seln As Long) As Double
'順列リストを作成の初期化処理
'input rng　順列リスト作成する標本セル範囲
' seln 抜き取り数
'output init_permut---順列数
　On Error Resume Next
　　Dim g0 As Long
　　Dim crng As Range
　　p_svn = seln
　　Erase p_myarray()
　　Erase p_idx()
　　g0 = 1
　　ReDim p_myarray(1 To rng.Count)
　　For Each crng In rng
　　　p_myarray(g0) = crng.Value
　　　g0 = g0 + 1
　　　Next
　　ReDim p_idx(1 To seln)
　　For g0 = 1 To UBound(p_idx())
　　　p_idx(g0) = 1
　　　Next
　　init_permut = WorksheetFunction.Permut(rng.Count, seln)
End Function
'========================================================================================
Function get_permut(ans(), Optional ByVal n_cnt As Long = 1) As Long
'init_permutの指定に基づく順列リストを取得する
'output ans() 順列リストを配列で出力する
'　　　　　　　　予め必要な配列領域は呼び出し側で用意すること
'　　　　　　　　尚、指定配列の添え字ベースは1とする
'　　　　get_permut 0　正常に順列リストを取得　1　順列リストはなし
　Dim g0 As Long
　Dim g1 As Long
　Dim retcode As Long
　get_permut = 1
　For g0 = p_idx(n_cnt) To UBound(p_myarray())
　　　retcode = 0
　　　For g1 = LBound(p_idx()) To n_cnt - 1
　　　　　If p_idx(g1) = g0 Then
　　　　　　retcode = 1
　　　　　　Exit For
　　　　　　End If
　　　　　Next g1
　　　If retcode = 0 Then
　　　　　ans(n_cnt) = p_myarray(g0)
　　　　　p_idx(n_cnt) = g0
　　　　　If n_cnt < UBound(p_idx()) Then
　　　　　　get_permut = get_permut(ans(), n_cnt + 1)
　　　　　Else
　　　　　　p_idx(n_cnt) = g0 + 1
　　　　　　get_permut = 0
　　　　　　End If
　　　　　End If
　　　If get_permut = 0 Then Exit For
　　　Next g0
　If get_permut = 1 Then
　　　p_idx(n_cnt) = 1
　　　End If
End Function
'======================================================================================
Sub term_permut()
'順列リストを作成の終了処理
'（ファイルだって、Openすれば、クローズするよね）
　　Erase p_myarray()
　　Erase p_idx()
End Sub

これでmainを実行してみてください。

例題コードは、アクティブシートのA1:G1に入力された
１～７の数字を乱数によって、選定された抜き取り数で
順列リストを３行目から表示します。

順列リスト作成プログラムパックは、私は、普段はクラスモジュールで
運用していますが、今回は標準モジュールにしました。

試してみてください

回答No.1

hige_082

過去に似たような質問があります

http://okwave.jp/qa1634838.html

http://okwave.jp/qa1126322.html

http://okwave.jp/qa1128457.html

参考にしてください