VBA Excel 中的排列

Question

我正在尝试生成字符数组的所有可能组合。输入数组有 n 个字符，5 <= n <= 7，我想生成包含所有 C( n , 5 ) 组合的第二个数组 A( C( n , 5 ) , 5 )。数组中字符的顺序并不重要。

这是一个例子：输入数组：{ A, B, C, D, E, F } ，所以 n = 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},

这对于 n=5 和 n=6 非常简单，但对于 n=7 就变得非常复杂。有人知道我该怎么做吗？

谢谢

Answer 1

递归求解。

例如，您的 n = 7 案例。在外层，你从{A, B, C, D, E, F, G}开始。从这里，你取出一个字母；不同的 7 次。所以这个输出数组集中有 7 个元素，每个元素有 6 个字母：{A, B, C, D, E, F}, {A, B, C, D, E, G} 等

对于这些输出中的 each，您可以使用相同的算法进一步减少。您已经知道如何处理{A, B, C, D, E, F}。

Answer 2

这只是 Bathsheba 的 建议的实施，将生成所有 5-of-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中。然后在C1中输入：

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

并通过I1.
[=将C1复制到D1 42=]在C2中输入：

=DropCH(C,ROW()-1)

并从 D2 复制 C2 到 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

列中

Answer 3

刚刚找到一种方法使其递归并避免双重结果。代码非常丑陋，因为我没有时间考虑如何使用这里的循环。

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

VBA Excel 中的排列

Permutations in VBA Excel

algorithm

excel

vba

permutation

combinatorics