Вот функция, которая возвращает перестановку 1,...,n ранга i:
Function Unrank(ByVal n As Long, ByVal rank As Long, Optional lb As Long = 1) As Variant
Dim Permutation As Variant
Dim Items As Variant
ReDim Permutation(lb To lb + n - 1)
ReDim Items(0 To n - 1)
Dim i As Long, j As Long, k As Long, q As Long
Dim fact As Long
For i = 0 To n - 1
Items(i) = i + 1
Next i
rank = rank - 1
j = lb
For i = n - 1 To 1 Step -1
fact = Application.WorksheetFunction.fact(i)
q = Int(rank / fact)
Permutation(j) = Items(q)
'slide items above q 1 unit to left
For k = q + 1 To i
Items(k - 1) = Items(k)
Next k
j = j + 1
rank = rank Mod fact
Next i
'place last item:
Permutation(lb + n - 1) = Items(0)
Unrank = Permutation
End Function
По умолчанию возвращает результат в виде массива на основе 1. Чтобы сделать его основанным на 0, используйте вызов типа Unrank(5,7,0). В качестве теста:
Sub test()
'fills A1:A120 with the permutations of 1,2,3,4,5
Dim i As Long
For i = 1 To 120
Cells(i, 1).Value = Join(Unrank(5, i), " ")
Next i
End Sub
13! слишком велик, чтобы его можно было хранить в переменной Long, поэтому код выдает ошибку без перехвата, когда n=14. Алгоритм, который я использую, зависит от способности выполнять модульную арифметику с соответствующими факториалами, поэтому в VBA нет простого решения. Обратите внимание, что вы можете легко настроить код, чтобы передать ему массив элементов для перестановки, а не всегда переставлять 1-n. Алгоритм уничтожает массив Items, поэтому такая подстройка потребует создания копии переданного массива на основе 0 (чтобы сработала модульная арифметика).