Excel VBA質問箱 IV

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

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


19617 / 76732 ←次へ | 前へ→

【62544】Re:複数単語の全組み合わせを作成したい
発言  SS  - 09/7/29(水) 14:17 -

引用なし
パスワード
   ▼MIE さん:

力技でやるとこんな感じですかね
超初心者さんもおっしゃっているように文字列が8を超えると
シートに納まらなくなります。
Subの中で自分自身をCallしていますがプログラム上良いことなのか分かりません。
識者の方々に添削していただきたい気持ちでいっぱいです。

Option Explicit
Public AA As Variant
Public myarray As Variant

Sub test()
  Dim i As Long, j As Long, k As Long, l As Long, m As Long
  Dim txtNo As Long
  ReDim AA(10)
  Columns("B:IV").ClearContents
  m = Range("A65536").End(xlUp).Row
  
  For i = 1 To m
    myarray = Split(Cells(i, 1).Value, " ")
    txtNo = UBound(myarray, 1)
    
    ReDim AA(txtNo)
    Call ForNext(txtNo, txtNo, i)
  Next i
End Sub

Sub ForNext(m As Long, n As Long, o As Long)
  Dim i As Long, j As Long, k As Long, ARow As Long
  Dim txtA As String
  For i = 0 To n
    k = 0
    For j = n To m Step -1
      If AA(j) = i And AA(j) <> "" Then k = 1: Exit For
    Next j
    AA(m) = i
    If m > 0 And k = 0 Then
      Call ForNext(m - 1, n, o)
    End If
    If m = 0 And k = 0 Then
      txtA = myarray(AA(n))
      For j = n - 1 To 0 Step -1
        txtA = txtA & " " & myarray(AA(j))
      Next j
      Cells(Cells(65536,o+1).End(xlUp).Row+1, o+1).Value = txtA
    End If
  Next i
End Sub


>セルに、スペースで区切られた単語が入っています。
>この単語の全ての組み合わせをVBAで作成したいのですが、可能でしょうか?
>
>例えば
>
>A B  ⇒ A B
>   ⇒ B A
>
>A B C ⇒ A B C
>   ⇒ A C B
>   ⇒ B A C
>   ⇒ B C A
>   ⇒ C A B
>   ⇒ C B A
>
>・・という感じです。
>
>単語は1つのセルにスペースで区切られて入っており、単語数には上限が無い状況です。
>また、処理したいセル数も数千になる可能性があり、処理速度も求められております。
>
>何か方法がございましたら、是非ご伝授ください。
>何卒宜しくお願いいたします。

166 hits

【62533】複数単語の全組み合わせを作成したい MIE 09/7/29(水) 10:49 質問
【62542】Re:複数単語の全組み合わせを作成したい 超初心者 09/7/29(水) 14:04 発言
【62543】Re:複数単語の全組み合わせを作成したい MIE 09/7/29(水) 14:13 お礼
【62544】Re:複数単語の全組み合わせを作成したい SS 09/7/29(水) 14:17 発言
【62557】Re:複数単語の全組み合わせを作成したい ichinose 09/7/30(木) 8:28 発言

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