RosettaCodeData/Task/Permutations/VBA/permutations.vba

83 lines
1.1 KiB
Plaintext

Public Sub Permute(n As Integer, Optional printem As Boolean = True)
'Generate, count and print (if printem is not false) all permutations of first n integers
Dim P() As Integer
Dim t As Integer, i As Integer, j As Integer, k As Integer
Dim count As Long
Dim Last As Boolean
If n <= 1 Then
Debug.Print "Please give a number greater than 1"
Exit Sub
End If
'Initialize
ReDim P(n)
For i = 1 To n
P(i) = i
Next
count = 0
Last = False
Do While Not Last
'print?
If printem Then
For t = 1 To n
Debug.Print P(t);
Next
Debug.Print
End If
count = count + 1
Last = True
i = n - 1
Do While i > 0
If P(i) < P(i + 1) Then
Last = False
Exit Do
End If
i = i - 1
Loop
j = i + 1
k = n
While j < k
' Swap p(j) and p(k)
t = P(j)
P(j) = P(k)
P(k) = t
j = j + 1
k = k - 1
Wend
j = n
While P(j) > P(i)
j = j - 1
Wend
j = j + 1
'Swap p(i) and p(j)
t = P(i)
P(i) = P(j)
P(j) = t
Loop 'While not last
Debug.Print "Number of permutations: "; count
End Sub