ＥＸＣＥＬマクロ

下記は０～９が重複せずに３つ、順番も考慮してシートに出すものです。
いわゆる=PERMUT(10,3)、数学で言えば10P3を力技で求めるもの。

さて、３つ程度のループなら下記のようにｉｆを書いても良いのですが
これが多重になればなるほど、ifが増えるので面倒になります。

なにか賢いアルゴリズムあったらご教示ください。
（使用目的は頭の体操、例えばポーカーの役の１回目に出る確率とかです。
　本計算とは関係ありませんが、理屈で考えたものを検証したい為です。）


Sub test()
r = 2
For a = 0 To 9
For b = 0 To 9
If b = a Then GoTo 10
For c = 0 To 9
If c = a Then GoTo 20
If c = b Then GoTo 20
Cells(r, 1) = a
Cells(r, 2) = b
Cells(r, 3) = c
r = r + 1
20 Next
10 Next
Next
End Sub

No.2 回答者： 30246kiku 回答日時： 2013/10/26 22:17

以下の様な感じではどうでしょうか

test1 を実行すると 0 ～ 9 の 3 つを使って・・・
test2 を実行すると A ～ J の 3 つを使って・・・
test3 を実行すると 混合のもので 3 つ使って・・・

関数にした ReCode は再帰呼び出しで利用します。

呼び出す時には、
第一引数は、常に True
第二引数は、使う数字または文字とかの配列
第三引数は、何個使って

以下では　Cells(1, 1) から書き出します。
ソコソコ動くと思いますが、不都合あれば修正してください。

※ 処理性能はわかりません


Dim iRow As Long
Dim iCol As Long

Private Sub ReCode(bTop As Boolean, vAry As Variant _
　　　　, iNst As Long, Optional vInAry As Variant)
　　Dim i As Long, j As Long
　　Dim vI As Variant, v As Variant

　　If (iNst <= 0) Then Exit Sub
　　If (bTop) Then
　　　　ReDim vI(1 To iNst)
　　　　Call ReCode(False, vAry, iNst, vI)
　　Else
　　　　vI = vInAry
　　　　j = UBound(vI) - iNst
　　　　For Each v In vAry
　　　　　　For i = 1 To j
　　　　　　　　If (vI(i) = v) Then Exit For
　　　　　　Next
　　　　　　If (i > j) Then
　　　　　　　　vI(j + 1) = v
　　　　　　　　If (iNst = 1) Then
　　　　　　　　　　Cells(iRow, iCol).Resize(, UBound(vI)) = vI　' Cell への書き出し
　　　　　　　　　　iRow = iRow + 1
　　　　　　　　Else
　　　　　　　　　　Call ReCode(False, vAry, iNst - 1, vI)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　End If
End Sub


Public Sub test1()
　　Dim vAry As Variant
　　Dim i As Long

　　ReDim vAry(9)
　　For i = 0 To 9
　　　　vAry(i) = i
　　Next

　　iRow = 1
　　iCol = 1
　　Call ReCode(True, vAry, 3)
End Sub

Public Sub test2()
　　Dim vAry As Variant
　　Dim i As Long

　　ReDim vAry(9)
　　For i = 0 To 9
　　　　vAry(i) = Chr(Asc("A") + i)
　　Next

　　iRow = 1
　　iCol = 1
　　Call ReCode(True, vAry, 3)
End Sub

Public Sub test3()
　　Dim vAry As Variant
　　Dim i As Long

　　ReDim vAry(9)
　　vAry(0) = "A"
　　vAry(1) = 1
　　vAry(2) = "B"
　　vAry(3) = 2
　　vAry(4) = "C"
　　vAry(5) = 3
　　vAry(6) = "D"
　　vAry(7) = 4
　　vAry(8) = "E"
　　vAry(9) = 5

　　iRow = 1
　　iCol = 1
　　Call ReCode(True, vAry, 3)
End Sub

No.1 回答者： okormazd 回答日時： 2013/10/26 14:56

nPr=n!/(n-r)!

を使う。

factは再帰で階乗を求める関数、fact2はforループで階乗を求める関数。どちらでも好きなほうをどうぞ。


Sub npr()

Dim n As Double, r As Double, npr As Double

n = 10
r = 3

' npr = fact(n) / fact(n - r)
npr = fact2(n) / fact2(n - r)

MsgBox npr

End Sub

Function fact(x As Double) As Double

If x = 0 Then
fact = 1
Else
fact = x * fact(x - 1)
End If

End Function



Function fact2(x As Double) As Double

Dim v As Double, i As Double

v = 1
For i = 1 To x
v = v * i
Next

fact2 = v

End Function

この回答へのお礼

回答ありがとうございます。
すいません、質問が悪かったようで、
欲しいのは１、２、３～９、８、７の７２０組の数字です。

お礼日時：2013/10/26 16:24