Перестановки в VBA Excel

Question

Я пытаюсь сгенерировать все возможные комбинации массива символов. Входной массив имеет n символов, 5 < = n < = 7, и я хотел бы сгенерировать второй массив A (C (n, 5), 5), который содержит все комбинации C (n, 5). Порядок символов в массиве не важен.

Ниже приведен пример: входной массив: {А, В, С, D, Е, F}, так что п = 6 выходной массив должен быть:

{A B C D E}, 
{A B C D F}, 
{A B C F E}, 
{A B F D E}, 
{A F C D E}, 
{F B C D E}, 

Это довольно просто для п = 5 и n = 6, но становится очень сложным при n = 7. Кто-нибудь знает, как мне это сделать?

Thanks

Answer 1

Просто нашел один способ сделать это рекурсивно и избегать двойных результатов. Код довольно уродливый, потому что у меня не было времени подумать, как использовать циклы здесь.

Public Function Permutacao (card1 As String, Card2 As String, card3 As String, card4 As String, card5 As String, Optional card6 As String, Optional card7 As String)

Dim A(1 To 7) As String 
Dim aux_A(1 To 7, 1 To 6) As String 
Dim aux2_A(1 To 6, 1 To 5) As String 
Dim final_A(1 To 42, 1 To 6) As String 

n = 5 

A(1) = card1 
A(2) = card2 
A(3) = card3 
A(4) = card4 
A(5) = card5 


If Not IsMissing(card6) Then 
    A(6) = card6 
    n = 6 
End If 
If Not IsMissing(card7) Then 
    A(7) = card7 
    n = 7 
End If 

If n = 5 Then 

    final_A(1, 1) = A(1) 
    final_A(1, 2) = A(2) 
    final_A(1, 3) = A(3) 
    final_A(1, 4) = A(4) 
    final_A(1, 5) = A(5) 

ElseIf n = 6 Then 

    k = 1 
    final_A(k, 1) = A(1) 
    final_A(k, 2) = A(2) 
    final_A(k, 3) = A(3) 
    final_A(k, 4) = A(4) 
    final_A(k, 5) = A(5) 

    k = 2 

    final_A(k, 1) = A(1) 
    final_A(k, 2) = A(2) 
    final_A(k, 3) = A(3) 
    final_A(k, 4) = A(4) 
    final_A(k, 5) = A(6) 

    k = 3 

    final_A(k, 1) = A(1) 
    final_A(k, 2) = A(2) 
    final_A(k, 3) = A(3) 
    final_A(k, 4) = A(6) 
    final_A(k, 5) = A(5) 

    k = 4 

    final_A(k, 1) = A(1) 
    final_A(k, 2) = A(2) 
    final_A(k, 3) = A(6) 
    final_A(k, 4) = A(4) 
    final_A(k, 5) = A(5) 

    k = 5 

    final_A(k, 1) = A(1) 
    final_A(k, 2) = A(6) 
    final_A(k, 3) = A(3) 
    final_A(k, 4) = A(4) 
    final_A(k, 5) = A(5) 

    k = 6 

    final_A(k, 1) = A(6) 
    final_A(k, 2) = A(2) 
    final_A(k, 3) = A(3) 
    final_A(k, 4) = A(4) 
    final_A(k, 5) = A(5) 

ElseIf n = 7 Then 

    k = 1 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(6) 

    k = 2 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(7) 

    k = 3 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(7) 
    aux_A(k, 6) = A(6) 

    k = 4 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(7) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(6) 

    k = 5 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(7) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(6) 

    k = 6 
    aux_A(k, 1) = A(1) 
    aux_A(k, 2) = A(7) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(6) 

    k = 7 
    aux_A(k, 1) = A(7) 
    aux_A(k, 2) = A(2) 
    aux_A(k, 3) = A(3) 
    aux_A(k, 4) = A(4) 
    aux_A(k, 5) = A(5) 
    aux_A(k, 6) = A(6) 

    c = 1 

    k = 1 

    While k <= 7 

     If k < 2 Then 
      final_A(c, 1) = aux_A(k, 1) 
      final_A(c, 2) = aux_A(k, 2) 
      final_A(c, 3) = aux_A(k, 3) 
      final_A(c, 4) = aux_A(k, 4) 
      final_A(c, 5) = aux_A(k, 5) 

      c = c + 1 

     End If 

     If k < 3 Then 


      final_A(c, 1) = aux_A(k, 1) 
      final_A(c, 2) = aux_A(k, 2) 
      final_A(c, 3) = aux_A(k, 3) 
      final_A(c, 4) = aux_A(k, 4) 
      final_A(c, 5) = aux_A(k, 6) 

      c = c + 1 

     End If 

     If k < 4 Then 

      final_A(c, 1) = aux_A(k, 1) 
      final_A(c, 2) = aux_A(k, 2) 
      final_A(c, 3) = aux_A(k, 3) 
      final_A(c, 4) = aux_A(k, 6) 
      final_A(c, 5) = aux_A(k, 5) 

      c = c + 1 
     End If 

     If k < 5 Then 

      final_A(c, 1) = aux_A(k, 1) 
      final_A(c, 2) = aux_A(k, 2) 
      final_A(c, 3) = aux_A(k, 6) 
      final_A(c, 4) = aux_A(k, 4) 
      final_A(c, 5) = aux_A(k, 5) 

      c = c + 1 
     End If 

     If k < 6 Then 

      final_A(c, 1) = aux_A(k, 1) 
      final_A(c, 2) = aux_A(k, 6) 
      final_A(c, 3) = aux_A(k, 3) 
      final_A(c, 4) = aux_A(k, 4) 
      final_A(c, 5) = aux_A(k, 5) 

      c = c + 1 
     End If 

     If k < 7 Then 

      final_A(c, 1) = aux_A(k, 6) 
      final_A(c, 2) = aux_A(k, 2) 
      final_A(c, 3) = aux_A(k, 3) 
      final_A(c, 4) = aux_A(k, 4) 
      final_A(c, 5) = aux_A(k, 5) 

      c = c + 1 

     End If 

     k = k + 1 

    Wend 


End If 

Permutacao = final_A 

End Function

Answer 2

Решите его рекурсивно.

Например, ваш случай n = 7. Во внешнем слое вы начинаете с {A, B, C, D, E, F, G}. Из этого вы берете одно письмо; другой 7 раз. Таким образом, у вас есть 7 элементов в этом массиве выходных массивов, каждый из которых имеет 6 букв: {A, B, C, D, E, F}, {A, B, C, D, E, G} и т. Д.

Для каждый из этих выходов, то вы затем уменьшаете, используя тот же алгоритм. Вы уже знаете, как бороться с {A, B, C, D, E, F}.

Answer 3

Это просто реализация предложения Вирсавии и произведет все 5-оф-7 «с. Сначала вставьте следующий UDF в стандартном модуле:

Public Function DropCH(sIn As String, L As Long) As String 
    If L = 1 Then 
     DropCH = Mid(sIn, 2) 
     Exit Function 
    End If 

    ll = Len(sIn) 
    If ll = L Then 
     DropCH = Left(sIn, L - 1) 
     Exit Function 
    End If 

    If L > ll Then 
     DropCH = "" 
     Exit Function 
    End If 
    DropCH = Mid(sIn, 1, L - 1) & Mid(sIn, L + 1) 
End Function 

Затем поместите строку 7 символов в A1. Затем в С1 входят:

=DropCH($A$1,COLUMNS($A:A)) 

и скопировать С1 к D1 через I1.

В C2 входят:

=DropCH(C$1,ROW()-1) 

и скопировать C2 от D2 через I2

Затем, чтобы удалить дубликаты запустить этот макрос:

Sub DropDuplicates() 
    Dim c As Collection, K As Long 
    Set c = New Collection 
    On Error Resume Next 
    K = 1 

    For Each r In Range("C2:I7") 
     If r.Value <> "" Then 
      c.Add r.Value, CStr(r.Value) 
      If Err.Number = 0 Then 
       Cells(K, "J").Value = r.Value 
       K = K + 1 
      Else 
       Err.Number = 0 
      End If 
     End If 
    Next r 
    On Error GoTo 0 
End Sub 

Это поместит результаты в колонке J