Permutations in VBA Excel

问题:

I am trying to generate all the possible combinations of an array of characters. The input array has n characters, 5 <= n <= 7, and I would like to generate a second array A( C( n , 5 ) , 5 ) that contains all the C( n , 5 ) combinations. The order of the characters in the array isn't important.

Here is an example: input array: { A, B, C, D, E, F } , so n = 6 output array should be:

{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},

This is pretty simple for n=5 and n=6, but gets very complicated for n=7. Does anyone know how should I make this ?

Thanks

回答1:

Solve it recursively.

For example, your n = 7 case. In the outer layer, you start with {A, B, C, D, E, F, G}. From this, you take one letter out; a different one 7 times. So you have 7 elements in this output array set, each with 6 letters: {A, B, C, D, E, F}, {A, B, C, D, E, G} etc.

For each of these outputs, you then further reduce using the same algorithm. You already know how to deal with {A, B, C, D, E, F}.

回答2:

This is just an implementation of Bathsheba's suggestion and will generate all the 5-of-7's. First insert the following UDF in a standard module:

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

Then place the 7 character string in A1. Then in C1 enter:

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

and copy C1 to D1 through I1.

In C2 enter:

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

and copy C2 from D2 through I2

Then to remove duplicates run this macro:

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

This will place the results in column J

回答3:

Just found one way to make it recursively and avoid double results. The code is pretty ugly cause I didn't have time to think how to use the loops here.

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