Question

A person can pick one of the three values from {1, 2, 3}

A person will pick one of the above three values 10 times to generate lists like

List 1: {1, 2, 3, 2, 1 , 2, 3, 1, 1, 2}

List 2: {1, 1, 3, 2, 1, 3, 3, 1, 1, 2}

List 3: {3, 3, 3, 2, 3, 1, 3, 1, 1, 2}

List 4: {1, 2, 3, 2, 3, 2, 3, 1, 1, 2}

.

.

.

.

?How many such unique lists are possible?

I know basic loops in vba like for, do while, while etc. But I can't think of the logic and how to implement in code. Please advise.

This is what I am trying but I am pretty sure its flawed.

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

Generate all possible unique combinations of picks

2 个答案: