複数のセットからすべての可能な組み合わせを作成する

Question

私は誤っていると言えば、数学の知識が限られているので、その言葉を許しています。 私は、そのセットから少なくとも1つのアイテムを含む複数のセットからすべての可能な組み合わせを作成する必要があります。

- SetA: [1, 2, 3, 4, 5, 6, 7] 
- SetB: [a, b, c, d] 
- SetC: [!, @, #, $, %] 

出力例：私はネストされたループを考え出すことができると私はそれも正しいかどうかはわからないので、

- [1,a,!] 
- [1,2,a,c,@] 
- [1,2,3,4,5,6,7,a,b,c,d,!,@,#,$,%] 

は、このための具体的な組み合わせ式あります。

Answer 1

@barrycarterはpower setを得る良いアイデアを持っていました。しかし、セットの集合のパワーセットを取得していないため、何も拒否する必要はありません（セットの数が増えるにつれ、多くの拒否が存在するため、効率が悪くなります）。単に各セットのパワーセットを取得し、それらのパワーセットのすべての組み合わせを取得します。下のサブルーチンは、任意の長さの任意の数の集合に対して動作します。

Sub CreateAllCombs() 

Dim ArrayOfPowSets() As Variant, mySet() As Variant, ArrCounter() As Long, myPS As Variant 
Dim myCombs() As Variant, nextComb() As Variant, ParentComb() As Variant, ArrMax() As Long 
Dim i As Long, j As Long, k As Long, count1 As Long, count2 As Long, CombExist As Boolean 
Dim tempCol As Long, myMax As Long, maxRow As Long, totalCombs As Long 

    With ActiveSheet 
     maxRow = .Cells(.Rows.count, "A").End(xlUp).Row 
    End With 

    ReDim ArrayOfSets(1 To maxRow, 1 To 1) 
    ReDim ArrCounter(1 To maxRow) 
    ReDim ArrMax(1 To maxRow) 
    myMax = 0 

    For i = 1 To maxRow 
     With ActiveSheet 
      tempCol = .Cells(i, .Columns.count).End(xlToLeft).Column 
     End With 
     ReDim mySet(1 To tempCol) 
     For j = 1 To tempCol: mySet(j) = Cells(i, j): Next j 
     myPS = PowerSet(mySet) 
     ArrMax(i) = UBound(myPS) 
     If ArrMax(i) > myMax Then 
      myMax = ArrMax(i) 
      ReDim Preserve ArrayOfPowSets(1 To maxRow, 1 To ArrMax(i)) 
     End If 
     For j = 1 To ArrMax(i) 
      ArrayOfPowSets(i, j) = myPS(j) 
     Next j 
     ArrCounter(i) = 1 
    Next i 

    CombExist = True 
    totalCombs = 0 

    Do While CombExist 
     count1 = 1 
     ReDim ParentComb(1 To 1) 

     For i = 1 To maxRow - 1 
      For j = 1 To UBound(ArrayOfPowSets(i, ArrCounter(i))) 
       ReDim Preserve ParentComb(1 To count1) 
       ParentComb(count1) = ArrayOfPowSets(i, ArrCounter(i))(j) 
       count1 = count1 + 1 
      Next j 
     Next i 

     For i = 1 To ArrMax(maxRow) 
      count2 = count1 
      nextComb = ParentComb 
      For j = 1 To UBound(ArrayOfPowSets(maxRow, i)) 
       ReDim Preserve nextComb(1 To count2) 
       nextComb(count2) = ArrayOfPowSets(maxRow, i)(j) 
       count2 = count2 + 1 
      Next j 
      totalCombs = totalCombs + 1 
      ReDim Preserve myCombs(1 To totalCombs) 
      myCombs(totalCombs) = nextComb 
     Next i 

     k = maxRow - 1 

     Do While (ArrCounter(k) >= ArrMax(k)) 
      ArrCounter(k) = 1 
      k = k - 1 
      If k = 0 Then Exit Do 
     Loop 

     If k > 0 Then ArrCounter(k) = ArrCounter(k) + 1 Else CombExist = False 

    Loop 

    Sheets("Sheet2").Select 

    For i = 1 To totalCombs 
     For j = 1 To UBound(myCombs(i)) 
      Cells(i, j) = myCombs(i)(j) 
     Next j 
    Next i 

End Sub 

私はSetB等行2、上にある、これはSetAは、行1であると仮定しhere

Function PowerSet(Items As Variant) As Variant 

    Dim PS As Variant 
    Dim i As Long, j As Long, k As Long, n As Long 
    Dim subset() As Variant 

    n = UBound(Items) 
    ReDim PS(1 To 1 + 2^n - 2) 
    For i = 1 To 2^n - 1 
     ReDim subset(1 To n) 
     k = 0 
     For j = 0 To n - 1 
      If i And 2^j Then 
       k = k + 1 
       subset(k) = Items(j + 1) 
      End If 
     Next j 
     ReDim Preserve subset(1 To k) 
     PS(i) = subset 
    Next i 

    PowerSet = PS 

End Function 

を発見ジョン・コールマンによって書かれた電力設定機能のわずかに変更されたバージョンを使用しましたお守り：

また、読者が1400万を超える可能な組み合わせがあるので、これはしばらく時間がかかるかもしれないと警告されなければなりません。

(2^3 - 1) * (2^5 - 1) * (2^16 - 1) = 7 * 31 * 65535 = 14221095 

また、全ての組み合わせは、Sheet2に総称的に記載されている。

Answer 2

入れ子のループを使用してみましたか？

Sub Hello() 
    MsgBox ("Hello, world!") 

    Dim arr1 
    arr1 = Array("1", "2", "3") 

    Dim arr2 
    arr2 = Array("a", "b", "c") 

    Dim arr3 
    arr3 = Array("!", "@", "$") 

    For i = 0 To UBound(arr1) 
     For j = 0 To UBound(arr2) 
      For k = 0 To UBound(arr3) 
       MsgBox (arr1(i) & arr2(j) & arr3(k)) 
      Next 
     Next 
    Next 
End Sub 

Answer 3

私の解決策を見つけたと思う。

まず、各セットのため、私はすべての可能な組み合わせを作成し、ヌル又はこの式なしパスカルの三角形の和を用いて、長さをチェック：

N/- （R（NR）！） 1

SETB：[A、B、C、D] - > [A、B、C、D、AB、AC、AD、BC、BD、CD、ABC、ABD、ACD、BCD、ABCD]

各セットのすべての可能な組み合わせを作成した後、私は、製品のルールを使用

[セタ] X [SETB] X [SETC]のためのすべての可能な組み合わせのために生じ

：

• の複数の項目
• 複数組
• ない反復
• ないため

リファレンス：https://www.mathsisfun.com/combinatorics/combinations-permutations-calculator.html

EDIT1：セットあたりの組み合わせの量をチェックすることもできます（2^N）-1ここで、n =セットの長さ