jak stworzyć listę ze wszystkimi możliwymi kombinacjami

Mam następującą tabelę:

a b c d ...
q w e r ...
z x   v ...
  p

Mam dużo problemów ze znalezieniem algorytmu (najlepiej VBA, ale w innych językach jest prawie taki sam sposób myślenia), który wygeneruje listę ze wszystkimi kombinacjami - poza tym, że mam tylko kilka wierszy, jest wiele kolumn i nie byłoby to poprawne, gdyby wykonano go ręcznie, ufam VBA, aby był w 100% kompletny.

więc wynik powinien wyglądać tak:

a
a,q
a,z
q,z
z
a/b
a/b,w
a/b,x
a/b,p
a/b,w,x
a/b,w,p
a/b,x,p
a/w
a/w,x
a/w,p
a/x
a/x,p
a/p
a,q/b
a,q/b,w
a,q/b,x
a,q/b,p
a,q/b,w,x
a,q/b,w,p
a,q/b,x,p
a,q/w
a,q/w,x
a,q/w,p
a,q/x
a,q/x,p
a,q/p
....etc.

• Naprawdę nie dbam o znaki „/” i „,”, znajdę sposób, aby je poprawić („/” znajduje się między elementami oddzielnych kolumn, podczas gdy „,” znajduje się między elementami z tej samej kolumny)

• kombinacje są wykonywane na dwa sposoby - w poziomie i w pionie z następującym ograniczeniem: można łączyć tylko elementy „n-1” (w poziomie i / lub w pionie)

Twój przykład wskazał 12 pozycji. Ten kod (dostarczany przez Johna Colemana w 2005 roku) będzie notować 4095 permutacji listy w kolumnie B . Istnieją 2 ^N -1 pozycji:

Sub MAIN()
    B = Array("a", "b", "c", "d", "q", "w", "e", "r", "z", "x", "v", "p")
    Call GrayCode(B)
End Sub

Function GrayCode(Items As Variant) As String
    Dim CodeVector() As Integer
    Dim i, kk As Integer
    Dim lower As Integer, upper As Integer
    Dim SubList As String
    Dim NewSub As String
    Dim done As Boolean
    Dim OddStep As Boolean

    kk = 1
    OddStep = True
    lower = LBound(Items)
    upper = UBound(Items)

    ReDim CodeVector(lower To upper) 'it starts all 0
    Do Until done
        'Add a new subset according to current contents
        'of CodeVector

        NewSub = ""
        For i = lower To upper
            If CodeVector(i) = 1 Then
                If NewSub = "" Then
                    NewSub = "," & Items(i)
                Else
                    NewSub = NewSub & "," & Items(i)
                End If
            End If
        Next i
        If NewSub = "" Then NewSub = "{}" 'empty set
        SubList = SubList & vbCrLf & NewSub
        Cells(kk, 2) = Mid(NewSub, 2)
        kk = kk + 1
        'now update code vector
        If OddStep Then
            'just flip first bit
            CodeVector(lower) = 1 - CodeVector(lower)
        Else
            'first locate first 1
            i = lower
            Do While CodeVector(i) <> 1
                i = i + 1
            Loop
            'done if i = upper:
            If i = upper Then
                done = True
            Else
                'if not done then flip the *next* bit:
                i = i + 1
                CodeVector(i) = 1 - CodeVector(i)
            End If
        End If
        OddStep = Not OddStep 'toggles between even and odd steps
    Loop
    GrayCode = SubList
End Function

Odniesienie:

Kod Johna Colemana

Możesz zmienić / dodać / usunąć elementy, zmieniając Array(). Zbyt wiele osób przekroczy limity liczby przedmiotów w kolumnie.