Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


13402 / 13644 ツリー ←次へ | 前へ→

【5548】組み合わせのプログラム教えてください。 ヒロ 03/5/19(月) 17:16 質問
【5549】Re:組み合わせのプログラム教えてください。 りん 03/5/19(月) 18:53 発言
【5553】Re:組み合わせのプログラム教えてください。 ichinose 03/5/19(月) 23:37 回答
【5562】Re:組み合わせのプログラム教えてください。 JuJu 03/5/20(火) 12:46 回答
【5567】Re:組み合わせのプログラム教えてください。 ichinose 03/5/20(火) 16:02 発言
【5589】Re:組み合わせのプログラム教えてください。 ヒロ 03/5/21(水) 10:54 お礼

【5548】組み合わせのプログラム教えてください。
質問  ヒロ  - 03/5/19(月) 17:16 -

引用なし
パスワード
   abcdef のすべての組み合わせをエクセルのシートに出力
するようなプログラムがわかる方教えてください。

例  abcの時

出力結果 
 abc
 acb
 bca
 bac
 dac
 dca

是非お願いします。出来れば簡単なプログラムでいいんで。よろしくです。

【5549】Re:組み合わせのプログラム教えてください...
発言  りん E-MAIL  - 03/5/19(月) 18:53 -

引用なし
パスワード
   ヒロ さん、こんばんわ

>abcdef のすべての組み合わせをエクセルのシートに出力
>するようなプログラムがわかる方教えてください。

このツリーが参考になりませんか?
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=5435;id=excel

【5553】Re:組み合わせのプログラム教えてください...
回答  ichinose  - 03/5/19(月) 23:37 -

引用なし
パスワード
   ▼りん さん:
ヒロさん、こんばんは。

>>abcdef のすべての組み合わせをエクセルのシートに出力
>>するようなプログラムがわかる方教えてください。
↑という内容だったので・・・・

>このツリーが参考になりませんか?
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=5435;id=excel
↑参考にして頂ければいいかな?と思ったのですが、

>例  abcの時

>出力結果 
> abc
> acb
> bca
> bac
> dac
> dca
これって、組み合わせじゃなくて、順列ですよね?
前回、組み合わせを作ったんで、「これで順列作っとけば何かのときに使えるかな」と
思っていたんでキッカケができてよかったです。
例題は、セルA1、B1、C1に"a","b","c"と入っていたとき、
A列の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"と入れたかったですか?

【5562】Re:組み合わせのプログラム教えてください...
回答  JuJu E-MAIL  - 03/5/20(火) 12:46 -

引用なし
パスワード
   ヒロさん、ichinoseさん、りんさん、こんにちはぁ

>>abcdef のすべての組み合わせをエクセルのシートに出力
>>するようなプログラムがわかる方教えてください。
↑という内容だったので・・・・

[#400]が参考になるかな?と思ったのですが、
入れ替え処理を使っているので、順番がばらばらですね。
なので、抜き出し処理に変えてみました。

結果は多分ichinoseさんと変わらないと思いますが、せっかく作ったので載せさせてください^^;

この手の処理には、再帰呼出(リカーシブコール)という方法を使います。
ichinoseさんのサンプルも私のサンプルも再帰しています。
とても役に立つテクニックなので、是非物にしてくださいね。

---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ---- 8= ---- 8< ----
Sub Macro1()

  Permute Range("A1"), "ABC"
End Sub

Sub Permute(ByRef rngData As Range, ByVal strData As String, Optional ByVal lngNum As Long = 1)
  Dim i As Long

  If lngNum < Len(strData) Then
    For i = lngNum To Len(strData)
      ' 再帰呼出
      Permute rngData, Left$(strData, lngNum - 1) & Mid$(strData, i, 1) & Mid$(strData, lngNum, i - lngNum) & Mid$(strData, i + 1), lngNum + 1
    Next
  Else
    ' 結果
    rngData.Value = strData
    Set rngData = rngData.Offset(1)
  End If
End Sub

【5567】Re:組み合わせのプログラム教えてください...
発言  ichinose  - 03/5/20(火) 16:02 -

引用なし
パスワード
   ▼JuJu さん:
こんにちは。

>この手の処理には、再帰呼出(リカーシブコール)という方法を使います。

私、別の投稿で「リカーシブル」って書いてました。
うる覚えで書くのは、まずいですね、反省です。
(横文字に弱い事を露呈してしまった)
これでは、やっぱり、試験には受からない・・・(何の試験に?)。

訂正していただいた形になりましたので、御礼申し上げます。
ありがとうございました。

【5589】Re:組み合わせのプログラム教えてください...
お礼  ヒロ  - 03/5/21(水) 10:54 -

引用なし
パスワード
   皆さん本当にありがとうございました。
御かげでとても助かりました。
これからも解らない事が出てきたときには
是非よろしくお願いします。

13402 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free