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

我有一个代码，现在工作，并列出了6个长度的数字。但他们是重复的。但这些数字是重复的。我需要唯一的非重复的6位数字。 我现在有这样的结果。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

---

交错嵌套循环：

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唯一的组合。

目前，如果您想找到不同长度的组合或具有不同

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

这将快速输出所有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个唯一组合）

---

先生，你帮了我这么多。@Nactrem你的代码设计得很好，很容易修改。谢谢。你能再帮我一点吗？。第一列以4结尾，我需要1到9作为第一列。@Nactrem我不知道在你的程序上下文中如何做。回答不错（+1）

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