列出所有可能的组合而不重复，VBA

Posted 2023-03-31

【中文标题】列出所有可能的组合而不重复，VBA

【英文标题】：Listing all possible combination without repetition,VBA

【发布时间】：2018-06-17 10:01:23

【问题描述】：

我有一个现在可以使用的代码，并列出了 6 长度的数字。但它们是重复的。但这些数字是重复的。我需要唯一的非重复 6 位数字。 我现在有这种结果。1 1 1 3 4 6 但我需要不同且不重复的结果。谢谢你的帮助。

Sub AllCombinations()
Dim nums(): nums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Dim arValues(999999, 5)
Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer, n6 As Integer, x As Long

For n1 = 0 To UBound(nums)
    For n2 = 0 To UBound(nums)
        For n3 = 0 To UBound(nums)
            For n4 = 0 To UBound(nums)
                For n5 = 0 To UBound(nums)
                    For n6 = 0 To UBound(nums)
                    arValues(x, 0) = nums(n1)
                    arValues(x, 1) = nums(n2)
                    arValues(x, 2) = nums(n3)
                    arValues(x, 3) = nums(n4)
                    arValues(x, 4) = nums(n5)
                    arValues(x, 5) = nums(n6)
                    x = x + 1
                Next
            Next
        Next
       Next
   Next
  Next
      Range("A1").Resize(1000000, 6).Value2 = arValues

 End Sub

【参考方案1】：

就目前而言，如果您想查找不同长度的组合或具有不同Ubound 的数组的组合，则必须更改您的代码。这会变得非常乏味并且容易出错。这是一个更通用的解决方案，适用于任何类型、任何大小和任何输出长度的数组。

Sub CombosNoRep(ByRef v() As Variant, r As Long)
Dim i As Long, k As Long, z() As Variant, comboMatrix() As Variant
Dim numRows As Long, numIter As Long, n As Long, count As Long

    count = 1
    n = UBound(v)
    numRows = nChooseK(n, r)

    ReDim z(1 To r)
    ReDim comboMatrix(1 To numRows, 1 To r)
    For i = 1 To r: z(i) = i: Next i

    Do While (count <= numRows)
        numIter = n - z(r) + 1
        For i = 1 To numIter
            For k = 1 To r: comboMatrix(count, k) = v(z(k)): Next k
            count = count + 1
            z(r) = z(r) + 1
        Next i

        For i = r - 1 To 1 Step -1
            If Not (z(i) = (n - r + i)) Then
                z(i) = z(i) + 1
                For k = (i + 1) To r: z(k) = z(k - 1) + 1: Next k
                Exit For
            End If
        Next i
    Loop

    Range("A1").Resize(numRows, r).Value2 = comboMatrix
End Sub

Function nChooseK(n As Long, k As Long) As Long
''returns the number of k-combinations from a set
''of n elements. Mathematically speaking, we have: n!/(k!*(n-k)!)
Dim temp As Double, i As Long
    temp = 1
    For i = 1 To k: temp = temp * (n - k + i) / i: Next i
    nChooseK = CLng(temp)
End Function

我们有这样的称呼：

Sub Test()
Dim myArray(1 To 9) As Variant, i As Long
    For i = 1 To 9: myArray(i) = i: Next i
    Call CombosNoRep(myArray, 6)
End Sub

这会快速输出所有 84 个独特的组合。

让我们在带有字符串的数组上尝试一下。

Sub Test()
Dim myArray() As Variant, i As Long
    '' Added blank "" as CombosNoRep is expecting base 1 array
    myArray = Array("", "Canada", "England", "Laos", "Ethiopia", "Burma", "Latvia", "Serbia", "Chile", "France", "Tonga")
    Call CombosNoRep(myArray, 4)
End Sub

这里有我们国家/地区数组的所有 4 元组（210 个独特的组合）。

【讨论】：

不错的答案(+1)

【参考方案2】：

错开嵌套循环：

Sub AllCombinations()
Dim nums(): nums = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
Dim arValues(999999, 5)
Dim n1 As Integer, n2 As Integer, n3 As Integer, n4 As Integer, n5 As Integer, n6 As Integer, x As Long

For n1 = 0 To UBound(nums)
    For n2 = n1 + 1 To UBound(nums)
        For n3 = n2 + 1 To UBound(nums)
            For n4 = n3 + 1 To UBound(nums)
                For n5 = n4 + 1 To UBound(nums)
                    For n6 = n5 + 1 To UBound(nums)
                    arValues(x, 0) = nums(n1)
                    arValues(x, 1) = nums(n2)
                    arValues(x, 2) = nums(n3)
                    arValues(x, 3) = nums(n4)
                    arValues(x, 4) = nums(n5)
                    arValues(x, 5) = nums(n6)
                    x = x + 1
                Next
            Next
        Next
       Next
   Next
  Next
      Range("A1").Resize(1000000, 6).Value2 = arValues

 End Sub

适用于所有 84 个独特的组合。

【讨论】：

先生，您帮了我很多。

@Nactrem 您的代码设计精良，易于修改。

谢谢。你能帮我多一点吗？第一列以 4 结尾，我需要 1 到 9 作为第一列。

@Nactrem 我不知道如何在您的程序上下文中执行此操作。