Question

我正在尝试生成Excel中单个列中包含的单词的 nPr 排列，其中＆nbsp;＆＃39; n＆＃39;和＆＃39; r＆＃39;是可变的。在下面给出的示例中，第一列包含单词，第二列包含输出。

在这种情况下，n = 3且r = 2

另一个例子，其中n = 3且r = 3：

到目前为止，我已经设法在VBA中找到了一个解决方案，它使用以下内容返回combinations而不是permutations：

Sub Perm()
    Dim i As Long, j As Long, last As Long
    Count = 2
    last = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To last
        For j = i + 1 To last
            Cells(Count, 2).Value = Cells(i, 1).Value & "," & Cells(j, 1).Value
            Count = Count + 1
        Next j
    Next i
End Sub

有了这个，我能够生成只有n作为变量的组合。 r固定为2。

Answer 1

一种递归方法，适用于任意数量的项目和任何r：

Function Permutations(items As Variant, r As Long, Optional delim As String = ",") As Variant
    'items is a 1-based array of items
    'returns all nPr permutations of items
    'returns a 1-based variant array
    'where each item is a delimited string
    'represented the permutation
    'r is assumed to be < n

    Dim n As Long, i As Long, j As Long, k As Long
    Dim rest As Variant, perms As Variant
    Dim item As Variant

    n = UBound(items) 'number of items
    ReDim perms(1 To Application.WorksheetFunction.Permut(n, r))

    If r = 1 Then
        'basis case
        For i = 1 To n
            perms(i) = items(i)
        Next i
    Else
        k = 1
        For i = 1 To n
            item = items(i)
            ReDim rest(1 To n - 1)
            For j = 1 To n - 1
                If j < i Then
                    rest(j) = items(j)
                Else
                    rest(j) = items(j + 1)
                End If
            Next j
            rest = Permutations(rest, r - 1)
            For j = 1 To UBound(rest)
                perms(k) = item & delim & rest(j)
                k = k + 1
            Next j
        Next i
    End If
    Permutations = perms
End Function

Sub test()
    Dim i As Long, n As Long
    Dim items As Variant

    n = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim items(1 To n)
    For i = 1 To n
        items(i) = Cells(i, 1).Value
    Next i
    items = Permutations(items, 3)
    For i = 1 To UBound(items)
        Cells(i, 2).Value = items(i)
    Next i
End Sub

例如：

一直到：

（注意210 = 7P3）。

Answer 2

有趣的问题。我用子和函数的组合解决了它，它生成了下一个级别，包括获取列中所有排列级别的选项：

Option Explicit

Const Delimiter As String = ", "
Private Base As Variant

Sub Permutations(Inp As Range, Nbr As Integer, OutpStart As Range, Optional All As Boolean = False)
Dim Arr
Dim Perm As Integer
    Base = Inp.Value2
    Arr = Inp.Value2
    For Perm = 2 To Nbr
        Arr = NextPermLvl(Arr)
    Next Perm

    OutpStart.Resize(UBound(Arr), 1).Value = IIf(Nbr = 1, Arr, (Application.Transpose(Arr)))
End Sub

Private Function NextPermLvl(ByVal Arr) As Variant
Dim OutArr() As String: ReDim OutArr(1 To 100000)
Dim OldVal, OldValArr, exst As Boolean, counter As Long
Dim BaseVal, BaseInOldVal
    For Each OldVal In Arr
        OldValArr = Split(OldVal, Delimiter)
        For Each BaseVal In Base
            exst = False
            For Each BaseInOldVal In OldValArr
                If BaseInOldVal = BaseVal Then exst = True: Exit For
            Next BaseInOldVal
            If Not exst Then
                counter = counter + 1
                OutArr(counter) = OldVal & Delimiter & BaseVal
            End If
        Next BaseVal
    Next OldVal
    ReDim Preserve OutArr(1 To counter)
    NextPermLvl = OutArr
End Function

Sub Test()
    Range("G2:G100000").ClearContents
    Permutations Range("A2:A5"), 3, Range("G2")
End Sub

基于输入在Excel中生成多个单元格的排列

2 个答案: