Excel VBA質問箱 IV

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

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


37495 / 76732 ←次へ | 前へ→

【44402】Re:単語群による順列の生成
発言  ichinose  - 06/11/15(水) 7:49 -

引用なし
パスワード
   ▼レイ さん:
おはようございます。
細かい仕様に不明な点がありますが、
この問題、順列リストが作成できれば、処理の早い遅いの差はあっても
概ね出来そうですけどね!!
順列リスト作成するコードは以前作ったことがあります。


こんな例を考えます。

アクティブシートの
セルA1〜E1にそれぞれ

a b c d e

というアルファベットが入っています。
(これは、アクティブシートのA1〜E1に予め入力して置いてください)

この5個の文字から3を抜き出す順列リストを考えます。
但し、aという文字は必ず入っていること。

順列リストは、セルA5から、下行に書き出すことにします。


標準モジュールに
'===============================================================
Sub main()
  Dim ans(1 To 2) As Variant
  Dim g0 As Long
  Dim myarray As Variant
  Call init_permut(Range("b1:e1"), 2)
  g0 = 5
  Do While get_permut(ans()) = 0
    myarray = get_reconvert(Range("a1").Value, ans())
    Do While TypeName(myarray) = "Variant()"
     Cells(g0, 1).Value = Join(myarray, " ")
     g0 = g0 + 1
     myarray = get_reconvert
     Loop
    Loop
  Call close_permut
End Sub
'=======================================================================
Function get_reconvert(Optional ByVal myvalue As Variant = "", Optional ByVal myarray As Variant) As Variant
  Static s_val As Variant
  Static s_array As Variant
  Static cnt As Long
  Dim g0 As Long, g1 As Long
  If myvalue <> "" Then
    s_val = myvalue
    s_array = myarray
    cnt = LBound(s_array)
    End If
  If cnt > UBound(s_array) + 1 Then
    get_reconvert = ""
  Else
    ReDim ans(LBound(s_array) To UBound(s_array) + 1)
    g1 = LBound(s_array)
    For g0 = LBound(s_array) To UBound(s_array)
     If cnt = g0 Then
       ans(g1) = s_val
       g1 = g1 + 1
       End If
     ans(g1) = s_array(g0)
     g1 = g1 + 1
     Next
    If cnt = g0 Then
     ans(g1) = s_val
     End If
    cnt = cnt + 1
    get_reconvert = ans()
    End If
End Function


別の標準モジュールに
順列リスト作成ルーチン
'===============================================================
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 close_permut()
'順列リストを作成の終了処理
'(ファイルだって、Openすれば、クローズするよね)
  Erase p_myarray()
  Erase p_idx()
End Sub


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


セルA5から、文字aを含む3構成の順列リストが作成されるはずです。

後は、上記コードを検討して頂いて、仕様に合わせて改良してください。

0 hits

【44401】単語群による順列の生成 レイ 06/11/15(水) 2:18 質問
【44402】Re:単語群による順列の生成 ichinose 06/11/15(水) 7:49 発言
【44405】Re:単語群による順列の生成 レイ 06/11/15(水) 9:40 お礼

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