[[20141223174811]]　『VBAで文字列の全ての組み合わせパターンを算出すａx（スフレ）　ページの最後に飛ぶ

『VBAで文字列の全ての組み合わせパターンを算出する方法』（スフレ）

VBAで文字列の全ての組み合わせパターンを算出する方法をお教えください。
配列に文字列が入っています。配列サイズは不定です。想定サイズは2～5です。
例えば

 Dim str(3) As String
 str(0) = "りんご"
 str(1) = "すいか"
 str(2) = "みかん"

という配列があった場合、この配列の全ての組み合わせパターンを作りたいです。
結果は、

 りんご,すいか,みかん
 りんご,みかん,すいか
 すいか,りんご,みかん
 すいか,みかん,りんご
 みかん,りんご,すいか
 みかん,すいか,りんご

となる結果を得たいです。

いろいろ自分でも検索して調べましたがExcelの表関数を使ったものやExcelのメニュー機能のばかり出てきて参考になりませんでした。

お手数をお掛けしますがどうぞよろしくお願い致します。

＜使用 Excel：Excel2007、使用 OS：Windows8 ＞

 ここの　校内全文検索　で　順列　で検索すれば　いくつか同じような内容のスレッドがありますよ！！
 この問題、　配列のサイズとは、　順列数を求める　nＰr のnの標本数ことですよね！！
 これはいくつでも考え方は同じですが、　rの抜き取り数が可変になると面倒です。

 この抜き取り数を　例題のように固定（3と固定）にして　アルゴリズムを完成させた後に、可変へと移っていく方が
 勉強の方法としては良いと思いますけどねえ！！

（ichinose） 2014/12/23(火) 22:07

ichinoseさん
ご回答ありがとうございました。
順列という言葉は知りませんでしたのでいろいろ調べておりました。
なかなか難しいですが前に進めそうな感じでした。
アドバイス頂きまして感謝致します。
どうぞよろしくお願い致します。
（スフレ） 2014/12/24(水) 12:17

VBAで考えると、汎用性を出すのはちょっと面倒かな、と思ったので、サンプルを書いてみました。
考え方は、要素の個数をｎ進数に見立てて、0から最大までループ。重複する数字が無い場合は書き出す、という感じです。
（3つの例だと3進数。012が該当する最小で、210が最大）

 Sub test()
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim iw As Long
    Dim iR As Long
    Dim iMax As Long
    Dim iDim() As Long
    Dim cDim As Variant

    cDim = Array("りんご", "すいか", "みかん")
    iMax = UBound(cDim) + 1
    ReDim iDim(iMax - 1)

    For i = 0 To iMax ^ iMax - 1
        iw = i
        For j = iMax - 1 To 0 Step -1
            iDim(j) = iw Mod iMax
            iw = (iw - iDim(j)) / iMax
        Next j

        For j = 0 To iMax - 1
            For k = j + 1 To iMax - 1
                If iDim(j) = iDim(k) Then
                    GoTo sNext
                End If
            Next k
        Next j

        iR = iR + 1
        For j = 1 To iMax
            Cells(iR, j).Value = cDim(iDim(j - 1))
        Next j
 sNext:
    Next i
 End Sub
（???） 2014/12/24(水) 15:41

 調べると結構ありますねぇ。
 この入れ替えて再帰呼び出し、いくらステップ実行しても理解できない・・・

 リンク先のコードをそのまま使いました。
http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1055086750

    'http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q1055086750
    Dim N As Long
    Dim K As Long
    Dim P() As Long
    Dim ans()
    Dim str() As String
    Sub perm_test()
        Dim i As Long
        K = 1
        ReDim str(1 To 5)
        str(1) = "りんご"
        str(2) = "みかん"
        str(3) = "ばなな"
        str(4) = "きうい"
        str(5) = "いちご"
        N = UBound(str)
        ReDim P(1 To N)
        ReDim ans(1 To N ^ N)
        For i = 1 To N
            P(i) = i
        Next i
        Perm 1
        ActiveSheet.Cells.ClearContents
        Range("A1").Resize(N ^ N).Value = Application.Transpose(ans)
    End Sub
    Private Sub Perm(i As Long)
        Dim j As Long
        If i < N Then
            For j = i To N
                Swap P(i), P(j)
                Perm i + 1
                Swap P(i), P(j)
            Next j
        Else
            For j = 1 To N
                ans(K) = ans(K) & "," & str(P(j))
            Next j
            ans(K) = Mid(ans(K), 2)
            K = K + 1
        End If
    End Sub
    Private Sub Swap(ByRef A As Long, B As Long)
        Dim T As Long
        T = A
        A = B
        B = T
    End Sub

（稲葉） 2014/12/24(水) 16:27

 稲葉さん、コード拝見しました。

 >この入れ替えて再帰呼び出し
 検索ロジックなら、順次検索、ソートロジックなら、Max(Min）関数を使って一つづつ並べていく方法

 なんてのは、考え方としては、思いつきますが、２分探索やクイックソートなんて手法は、
 その手のロジックを勉強しなければ、中々　思いつくことは、ないですよね！！

 今回の順列に関しても　総当たりで取得したリストから重複のないリストだけ採用するという
 方法ぐらいしか私などには、思いついきません。

 Swapしていくことで　順列リストを取得する方法なんて　ロジックを見せてもらって　習得するたぐいの手法ですね！！　処理も速いでしょうねえ

 私も以前順列リスト作成コードを投稿したことがありました。

[[20091010143423]]

 これを作成するときは、インターフェースは、
 最初から　ファイルのOpen、Line Input、 Closeと同じようにする決めていました。

 ただ、常に重複チェックが必要な事が悩みの種でした。

 稲葉さんの方法だとn！分だけの処理なので速いですね！！

 後は、1リスト取得ごと呼び出し元に戻したいなあ・・・。

 因みに
 >ReDim ans(1 To N ^ N)

  ReDim ans(1 To WorksheetFunction.Fact(N))

  Range("A1").Resize(UBound(ans)).Value = Application.Transpose(ans)

 これで十分ですね

（　ichinose） 2014/12/26(金) 20:49

 すみません、投稿の最初に書いてある通り全部コピーなんです・・・

 3日間位悩み続けてようやく理解できるようになりました。
 1234    1-1
  1234   2-2
   1234  3-3　☆
   1234  3-3　☆
   1243  3-4
   1234  3-4
  1234   2-2
  1324   2-3
   1324  3-3　☆
   1324  3-3　☆
   1342  3-4
   1324  3-4
  1234   2-3
  1432   2-4
   1432  3-3　☆
   1432  3-3  ☆
   1423  3-4  
   1432  3-4  
  1234   2-4
 1234    1-1
 2134    1-2
 ・・・
 こんな感じに出力して、なるほどと思った次第です。
 そんで、☆つけた3と3を入れ替えるところを省略できればもっと短くできるのかなーとか
 考えていますが、どうすればできるのかなーと・・・

 ＞ReDim ans(1 To WorksheetFunction.Fact(N))
 そういえばそんな関数ありましたね！！
 普段使わないと忘れてしまいます・・・

（稲葉） 2014/12/27(土) 08:48

コメント返信：

[ 一覧(最新更新順) ]

[[20141223174811]] 『VBAで文字列の全ての組み合わせパターンを算出すａx（スフレ） ページの最後に飛ぶ

[[20141223174811]]　『VBAで文字列の全ての組み合わせパターンを算出すａx（スフレ）　ページの最後に飛ぶ