エクセル 文字列順全通り組み合わせ

Excelの文字列の全通りの組み合わせを出力がしたいのですが、その方法が分かりません。

以前の記事に似た質問になり（https://oshiete.goo.ne.jp/qa/4122783.html）、ベストアンサーを参考にさせて頂いたのですが、こちらは2文字列の場合の回答で、3文字列のデータの全組み合わせを表示させたいのですが、VBAの知識がなく書き直すことができません。どなたか教えて頂けないでしょうか。

次の文字が1行目からあるとして

例えばセルＡに
・りんご
・みかん
・いちご

セルＢに
・だいこん
・キャベツ
・トマト

セルCに
・卵
・ハム
・ベーコン

これらを次の通り、隣のシートに転記したいです。文字の間には半角スペース
りんご だいこん 卵
りんご だいこん ハム
りんご だいこん ベーコン
りんご キャベツ 卵
りんご キャベツ ハム
りんご キャベツ ベーコン

といった感じです.

よろしくお願いします！

No.1 ベストアンサー 回答者： tom04 回答日時： 2019/02/15 16:20

こんにちは！

元データはSheet1にA～C列の1行目からあるとし、Sheet2のA列に表示するとします。
一例です。
標準モジュールにしてください。

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, j As Long, k As Long, maxRow As Long
　Dim myStr As String, wS As Worksheet
　Dim myKey, myR
　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　wS.Range("A:A").ClearContents
　　　　With Worksheets("Sheet1")
　　　　　For j = 1 To 3
　　　　　　maxRow = WorksheetFunction.Max(maxRow, .Cells(Rows.Count, j).End(xlUp).Row)
　　　　　Next j
　　　　　　myR = Range(.Cells(1, "A"), .Cells(maxRow, "C"))
　　　　End With
　　　　　For i = 1 To maxRow
　　　　　　For j = 1 To maxRow
　　　　　　　For k = 1 To maxRow
　　　　　　　　If myR(i, 1) <> "" And myR(j, 2) <> "" And myR(k, 3) <> "" Then
　　　　　　　　　myStr = myR(i, 1) & " " & myR(j, 2) & " " & myR(k, 3)
　　　　　　　　　　If Not myDic.exists(myStr) Then
　　　　　　　　　　　myDic.Add myStr, ""
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　Next k
　　　　　　Next j
　　　　　Next i
　　　　myKey = myDic.keys
　　　　　myR = Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "A"))
　　　　　　For i = 0 To UBound(myKey)
　　　　　　　myR(i + 1, 1) = myKey(i)
　　　　　　Next i
　　　　　　　Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, "A")) = myR
　　　　　Set myDic = Nothing
　　　　　wS.Activate
　　　　　MsgBox "完了"
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

tom04様

ありがとうございます！できました（涙）。
図々しくもうひとつ質問させて頂きたいのですが、元データを増やした場合（例えばA列にいちごの次にパイナップルといれる）どうやって、sheet２の情報は更新されるのでしょうか。
無知すぎて申し訳ありませんが、教えて頂けましたら幸いです。
よろしくお願いします。

お礼日時：2019/02/15 21:24