как создать список со всеми возможными комбинациями

Question

У меня есть следующая таблица:

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

У меня много проблем с поиском алгоритма (желательно VBA, но в других языках мышление почти такое же), который генерирует список со всеми комбинациями - кроме того, что у меня всего несколько строк, есть много столбцов это не будет точным, если все сделано вручную, я надеюсь, что VBA сделает его на 100% полным.

Итак, на выходе должен быть такой список:

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.

• Меня не волнуют знаки "/" и ",", я найду способ их правильно расположить ("/" находится между элементами отдельных столбцов, а "," - между элементами из одного столбца)

• Комбинации выполняются двумя способами - горизонтально и вертикально со следующим ограничением: можно комбинировать только элементы n-1 (по горизонтали и / или по вертикали)

Answer 1

В вашем примере указано 12 пунктов. Этот код (предоставленный Джоном Коулманом в 2005 году) перечислит 4095 перестановок списка в столбце B. Есть 2 ^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

Ссылка:

Код Джона Коулмана

Вы можете изменить / добавить / удалить элементы, изменив Array() . Слишком много переполнит ограничения на количество элементов в столбце.