生成所有可能的独特选择组合

Question

一个人可以从 {1, 2, 3} 中选择三个值之一

一个人会选择上述三个值之一 10 次以生成类似的列表

列表 1：{1, 2, 3, 2, 1 , 2, 3, 1, 1, 2}

列表 2：{1, 1, 3, 2, 1, 3, 3, 1, 1, 2}

列表 3：{3, 3, 3, 2, 3, 1, 3, 1, 1, 2}

列表 4：{1, 2, 3, 2, 3, 2, 3, 1, 1, 2}

.

.

.

.

？可能有多少个这样的唯一列表？

我知道 vba 中的基本循环，例如 for、do while、while 等。但我想不出其中的逻辑以及如何在代码中实现。请指教。

这是我正在尝试的，但我很确定它有缺陷。

Sub genComb()

Application.ScreenUpdating = False

fO = 2

For i = 1 To 3

    For j = 1 To 3
         
        For m = 1 To 3
                               
            For n = 1 To 10
                Cells(fo,n) = m
               
            
            Next n
            fo = fo +1 
        Next m
    
    Next i
    
Next j

Application.ScreenUpdating = True

End Sub

Answer 1

递归方法很自然：

Function Product(A As Variant, B As Variant, Optional delim As String = "/") As Variant
    'Returns the Cartesian product of two 1-based 1-dimensional arrays
    'The output is a 1-dimensional array of delimited strings
    Dim Prod As Variant
    Dim i As Long, j As Long, k As Long, m As Long, n As Long

    m = UBound(A)
    n = UBound(B)
    ReDim Prod(1 To m * n)

    For i = 1 To m
        For j = 1 To n
            k = k + 1
            Prod(k) = A(i) & delim & B(j)
        Next j
    Next i

    Product = Prod
End Function

Function Power(A As Variant, n As Long, Optional delim As String = "/") As Variant
    'Returns the n-fold Cartesian power of the 1-based, 1-d array A
    'Returns the resul as an array of delimited strings
    Dim Pow As Variant
    Dim i As Long, m As Long

    If n = 1 Then
        'return a copy of A
        m = UBound(A)
        ReDim Pow(1 To m)
        For i = 1 To m
            Pow(i) = A(i)
        Next i
    Else
        Pow = Product(A, Power(A, n - 1, delim))
    End If

    Power = Pow
End Function

Function SplitArray(A As Variant, Optional delim As String = "/") As Variant
    'A is a 1-based array of delimited strings, all of which
    'are assumed to have the same number of fields
    'each entry is split into a row of the returned 2-d matrix

    Dim i As Long, j As Long, k As Long, m As Long, n As Long
    Dim B As Variant, R As Variant

    m = UBound(A)
    R = Split(A(1), delim)
    n = UBound(R) - LBound(R) + 1

    ReDim B(1 To m, 1 To n)
    For i = 1 To m
        k = 0
        R = Split(A(i), delim)
        For j = LBound(R) To UBound(R)
            k = k + 1
            B(i, k) = R(j)
        Next j
    Next i
    SplitArray = B
End Function

Sub test()
    Dim A(1 To 3) As Long
    Dim i As Long
    Dim B As Variant
    A(1) = 1: A(2) = 2: A(3) = 3
    B = SplitArray(Power(A, 10))
    Range("A1:J59049").Value = B '3^10 = 59049
End Sub

当test 运行时，它会在前 10 列中填充所需的数字。可以对代码进行调整，使其仅适用于基于 1 的数组并不是最大的灵活性，并且一些错误检查可能不会造成伤害。

Answer 2

看起来您正在尝试为一组 3 个元素和 10 个元素的子集生成一组重复的排列：

PR(n, k) = n ^ k 
         = 3 ^ 10
         = 59049

一个简单的算法是重复第一列中的集合，然后重复上一列中的值n 次：

1  1  1  1  1  1  1  1  1  1
2  1  1  1  1  1  1  1  1  1
3  1  1  1  1  1  1  1  1  1
1  2  1  1  1  1  1  1  1  1
2  2  1  1  1  1  1  1  1  1
3  2  1  1  1  1  1  1  1  1
1  3  1  1  1  1  1  1  1  1
2  3  1  1  1  1  1  1  1  1
3  3  1  1  1  1  1  1  1  1
...

Sub Example()
  GetPermutationWithRepetition n:=3, k:=10, output:=[Sheet1!A1]
End Sub

Sub GetPermutationWithRepetition(n As Long, k As Long, output As Range)
  Dim r&, c&, repeat&, value&

  ReDim data(1 To n ^ k, 1 To k)

  For c = 1 To k
    r = 1
    repeat = (n ^ (c - 1)) - 1

    Do While r <= UBound(data)
      For value = 1 To n
        For r = r To r + repeat
          data(r, c) = value
        Next
      Next
    Loop
  Next

  output.Resize(UBound(data, 1), UBound(data, 2)).Value2 = data
End Sub