como criar lista com todas as combinações possíveis

Question

Eu tenho a seguinte tabela:

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

Estou tendo muitos problemas para encontrar um algoritmo (preferencialmente VBA, mas o pensamento é quase o mesmo em outras linguagens) que gerará uma lista com todas as combinações - além do fato de que eu só tenho algumas linhas, há muitos de colunas e isso não seria preciso se feito manual, confio em VBA para torná-lo 100% completo.

então, a saída deve ser uma lista como esta:

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.

• Eu realmente não me importo com os sinais "/" e ",", vou encontrar uma maneira de colocá-los corretamente ("/" é entre elementos de colunas separadas enquanto "," está entre os elementos de a mesma coluna)

• as combinações são feitas de duas maneiras - horizontal e verticalmente com a seguinte restrição: só pode combinar elementos 'n-1' (horizontalmente e / ou verticalmente)

Answer 1

Seu exemplo indicou 12 itens. Este código (fornecido por John Coleman em 2005) listará as 4095 permutações da lista na coluna B . Existem 2 itens ^N -1:

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

Referência:

Código John Coleman

Você pode alterar / adicionar / remover itens alterando o Array() . Muitos irão transbordar os limites para o número de itens em uma coluna.