Мне это нужно было сегодня, и хотя уже приведенные ответы указали мне правильное направление, они не совсем то, что я хотел.
Вот реализация, использующая метод Heap. Длина массива должна быть не менее 3, а по практическим соображениям - не более 10 или около того, в зависимости от того, что вы хотите сделать, терпения и тактовой частоты.
Перед входом в цикл инициализируйте Perm(1 To N) с первой перестановкой, Stack(3 To N) с нулями * и Level с 2**. В конце цикла вызовите NextPerm, который вернет false, когда мы закончим.
* VB сделает это за вас.
** Вы можете немного изменить NextPerm, чтобы сделать это ненужным, но это более понятно.
Option Explicit
Function NextPerm(Perm() As Long, Stack() As Long, Level As Long) As Boolean
Dim N As Long
If Level = 2 Then
Swap Perm(1), Perm(2)
Level = 3
Else
While Stack(Level) = Level - 1
Stack(Level) = 0
If Level = UBound(Stack) Then Exit Function
Level = Level + 1
Wend
Stack(Level) = Stack(Level) + 1
If Level And 1 Then N = 1 Else N = Stack(Level)
Swap Perm(N), Perm(Level)
Level = 2
End If
NextPerm = True
End Function
Sub Swap(A As Long, B As Long)
A = A Xor B
B = A Xor B
A = A Xor B
End Sub
'This is just for testing.
Private Sub Form_Paint()
Const Max = 8
Dim A(1 To Max) As Long, I As Long
Dim S(3 To Max) As Long, J As Long
Dim Test As New Collection, T As String
For I = 1 To UBound(A)
A(I) = I
Next
Cls
ScaleLeft = 0
J = 2
Do
If CurrentY + TextHeight("0") > ScaleHeight Then
ScaleLeft = ScaleLeft - TextWidth(" 0 ") * (UBound(A) + 1)
CurrentY = 0
CurrentX = 0
End If
T = vbNullString
For I = 1 To UBound(A)
Print A(I);
T = T & Hex(A(I))
Next
Print
Test.Add Null, T
Loop While NextPerm(A, S, J)
J = 1
For I = 2 To UBound(A)
J = J * I
Next
If J <> Test.Count Then Stop
End Sub
Другие методы описаны различными авторами. Кнут описывает два, один дает лексический порядок, но сложен и медленен, другой известен как метод простых изменений. Цзе Гао и Дяньцзюнь Ван также написали интересную статью.