生成拾取

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,3,3,1,3,1,1,2}

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

。

。

。

。

？有多少這樣的唯一列表是可能的？

我知道vba中的基本循環，例如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

它看起來像你想生成一組與repetion排列的一組10種元素的3種元素和子集：

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