Excel2016で6P6を全て書き出したい

質問

６つのアルファベット「o,y,m,r,p,u」を並び替えたいのですが
6P6で７２０通りなのはわかりますが
oymrpu
oymrup
・・・
・・・
・・・
purmyo（以上720通り）
を表示する方法を教えてください
VBAという言葉しか知りません。
出来れば720通りをプリントアウトしたいです。

回答No.2

SI299792 · ベストアンサー

６文字固定なら、chie65535 のプログラムでもいいのですが、今後のため６文字以外でもできるようにしたプログラムを上げます。
９文字まで行けます。（10文字になるとExcel の最下行を超える）
'
Option Explicit
'
Sub Macro1()
'
　　Dim Pattern As String
　　Dim Count As Long
　　Dim OutDat As String
'
　　Pattern = "oymrpu"
　　OutDat = Pattern
'
　　Do While OutDat <> Pattern Or Count = 0
　　　　Cells(Count + 1, "A") = OutDat
　　　　Count = Count + 1
　　　　OutDat = Permutation(Pattern, Count)
　　Loop
End Sub
'
Function Permutation(ByVal Pattern As String, ByVal Count As Long) As String
'
　　Dim OutPat As String
　　Dim OutDat As String
　　Dim i1 As Integer
　　Dim Ptr As Integer
'
　　For i1 = 1 To Len(Pattern)
　　　　OutPat = Count Mod i1 & OutPat
　　　　Count = Count \ i1
　　Next i1
'
　　For i1 = 1 To Len(Pattern)
　　　　Ptr = Mid(OutPat, i1, 1)
　　　　OutDat = OutDat & Mid(Pattern, Ptr + 1, 1)
　　　　Pattern = Left(Pattern, Ptr) & Mid(Pattern, Ptr + 2)
　　Next i1
'
　　Permutation = OutDat
End Function

マクロの入力方法は、下記を参考にしてください。
わからなければご記入ください。

参考URL：

https://kokodane.com/macro_kouza.htm

お礼

ありがとうございます。
6文字以外でも挑戦したいので、参考にさせていただきます。

回答No.7

msMike

[No.4お礼]へのコメント、
「高校」時代に permutation を数学で習わなかった(記憶忘れ？)世代の私なので、お尋ねした次第でした。
皆さんも仰ってたかどうか未確認ですが、私が「Excel的には」と述べた理由は、順列組み合わせ関係の Excel関数」くらいの意味で使いました。

この場をお借りして、[No.6]の tsubu-yukiさんへ、
》 ご存知の上での…
いえ、全く知りませんでした。
ご親切に感謝しております。

回答No.6

tsubu-yuki

No,4 msMikeさま。
質問者さんに成り代わって失礼します。
恐らく、ご存知の上でのご発電とは存じておりますが・・・

Ｐは「パーミュテーション(Permutation)」の「Ｐ」です。
数学的には「ｎＰａ（ｎ・ａは自然数）」のように書き、
「ｎから（下に）数えてａ個の自然数の積」を求めます。
つまし、「６Ｐ６」は６から数えて６個の自然数の積。
　　６×５×４×３×２×１ ＝ ７２０
ということです。

なんとなく気になったもので、申し訳ありません。

回答No.5

SI299792

#2です。これは回答ではありません。
今気が付いたのですが、私はchie65535 さんを呼び捨てにしていました。これはタイプミスです。
ご容赦ください。

回答No.4

msMike

》 6P6で７２０通りなのはわかりますが…
参考までに教えてください、「6P6」とはどういう意味ですか？
Excel的には =PERMUT(6,6) だろうとは推察できますが。

お礼

みなさんが「Excel的には」というのが理解できませんが
高校数学の「６パーミテーション６」という意味です。
Excelの事がわからないので「数学的な」表記をさせていただきました。

回答No.3

imogasi

WEBを調べれば載ってますよ。
Googleで「VBA 順列の具体例｝などで照会するとたくさん記事がある。
今では、まずWEB照会せよ。例
https://okwave.jp/qa/q1634838.html
Wendy01さんの回答
Const N As Integer = 6 '生成する順列数　６文字
Dim k As Long
Dim p(1 To N)
Sub perm_test()
Dim i As Long
ActiveSheet.Cells.ClearContents
k = 0
For i = 1 To N
p(i) = i
Next i
perm 1
End Sub
Private Sub perm(i As Long)
Dim j As Long, t As Long
If i < N Then
For j = i To N
t = p(i): p(i) = p(j): p(j) = t
perm i + 1
t = p(i): p(i) = p(j): p(j) = t
Next j
Else
For j = 1 To N
Cells(k + 1, j).Value = p(j)
Next j
k = k + 1
End If
End Sub
数字を使った順列のケースを質問者の文字に変える。
小生がつけたし。
Sub test01()
Range("A1:F720").Replace What:="1", Replacement:="O"
Range("A1:F720").Replace What:="2", Replacement:="Y"
Range("A1:F720").Replace What:="3", Replacement:="M"
Range("A1:F720").Replace What:="4", Replacement:="R"
Range("A1:F720").Replace What:="5", Replacement:="P"
Range("A1:F720").Replace What:="6", Replacement:="U"
End Sub
結果　例示
一部A1:F５
O Y M R P U
O Y M R U P
O Y M P R U
O Y M P U R
O Y M U P R
・・・
Wendyさんは、VBAなどの随一の回答者と思う人で（最近回答されないようだが）、再帰（Recursive）という、プログラム手法では有名な方法を使っています。理系の人には身近な方法です。
＝＝
表題に「6P6」と書いていますが、「順列のすべてのケース」などと書くべきだと思いました。一見何かのソフトの名前かと思った。
==
ご存じと思いますが
エクセルの順列の場合の数は　=PERMUT(6,6)で
７２０です。
＝＝
むしろこういう質問して、勉強するのでなく、どういうアルゴリズムで、考えて、図示したらわかりやすいか（したがって自分も納得できる）考えるべきでしょう。
それをVBAコード化するのは、質問者のレベルでは、今の段階では質問するのはやむを得ないのでしょうが。
＝＝
For Next 　の６重®ループにして、右端も列から１字づつ変えたものを作るとか、１か所の隣り合う２文字を入れ替えて、入れ替える場所を移していくとか。
http://www.gizcollabo.jp/vbtomo/log/archive/choshoqa_16769_0.html
その他
http://thom.hateblo.jp/entry/2015/09/20/014832
などにアイデアが載っている。

お礼

ありがとうございます。
回答者様の言わんとする事は十分に理解できますし、その通りだと思います。
今回は、あまりにも私の実力不足と早急性が必要だったので丸写しが可能な方の回答を参考にさせてもらいました。
今後VBAまで学ぶことがある時は役立たせていただきます。

回答No.1

chie65536（@chie65535）

「ツール」→「マクロ」→「マクロ」で、マクロのダイアログを出して、「マクロ名」に「Macro1」と入力して、マクロを新規作成して下さい。

そして、VBAのエディタが開いたら、以下のコードを貼り付けます。

Sub Macro1()
Dim i1, i2, i3, i4, i5, i6
Dim m(6) As String
m(1) = "o"
m(2) = "y"
m(3) = "m"
m(4) = "r"
m(5) = "p"
m(6) = "u"
Range("A1").Select
For i1 = 1 To 6
For i2 = 1 To 6
If InStr(i1, i2) = 0 Then
For i3 = 1 To 6
If InStr(i1 & i2, i3) = 0 Then
For i4 = 1 To 6
If InStr(i1 & i2 & i3, i4) = 0 Then
For i5 = 1 To 6
If InStr(i1 & i2 & i3 & i4, i5) = 0 Then
For i6 = 1 To 6
If InStr(i1 & i2 & i3 & i4 & i5, i6) = 0 Then
ActiveCell = m(i1) & m(i2) & m(i3) & m(i4) & m(i5) & m(i6)
ActiveCell.Offset(1, 0).Select
End If
Next
End If
Next
End If
Next
End If
Next
End If
Next
Next
Range("A1").Select
End Sub

貼り付けたら、VBAエディタを閉じて、「ツール」→「マクロ」→「マクロ」で、作ったマクロを選択して「実行」ボタンを押して下さい。

この回答は
http://q.hatena.ne.jp/1147403262
のNo.3、gong1971氏の回答を参考にして作成しました。

お礼

お礼が遅くなりすみません。
今回はこれを使わせていただきました。