求高效的能输出N个数全排列的通用程序。

Question

用VB
不仅要代码，同时把你的算法简单地描述一下，好吗？这样我看懂就容易一些。
lxz1969首席执行官:能描述一下你的算法吗？你的代码运行速度确实比其他网友快，不过我看不懂。

Answer 1

这是我用插入法编的，绝对高效。
Private Function Jie(ByVal N As Long) As Long '返回N的阶乘
Dim I As Long
Jie = 1
For I = 1 To N
Jie = Jie * I
Next I
End Function
Private Sub Command2_Click()
Dim B() As String, A() As String, I As Long, N As Long, S As Long, J As Long
Command2.Enabled = False
N = 8 '输出8位全排列，结果存到数组B中。
ReDim A(N - 1)
For I = 0 To N - 1'这里产生要排列的数是01234567，当然你可以自行定义。
A(I) = CStr(N - I - 1)
Next I
S = Jie(N)
ReDim B(S - 1)
Open Environ("userprofile") + "\桌面\8阶排列.txt" For Output As #1
Pai A(), B()
For J = 0 To S - 1
Print #1, B(J)
Next J
Close #1
'本程序运行8阶全排列需要用时16秒，运行7阶全排列需要用时0.2秒。
MsgBox "OK"
Command2.Enabled = True
End Sub
Private Sub Pai(A() As String, B() As String) '插入法全排列过程
Dim I As Integer, C() As String, J As Long, N As Long, K As Long
B(0) = A(0)
For I = 1 To UBound(A)
J = 0
Do While Len(B(J)) = I
DoEvents
ReDim C(Len(B(J)))
On Error Resume Next
C(0) = A(I) + B(J)
For K = 1 To UBound(C)
C(K) = Left(B(J), K) + A(I) + Right(B(J), Len(B(J)) - K)
Next K
B(J) = C(0)
For N = 0 To UBound(B)
If B(N) = "" Then Exit For
Next N
For K = 1 To UBound(C)
B(N + K - 1) = C(K)
Next K
J = J + 1
Loop
Next I
End Sub

Answer 2

我这个算法是按数组的下标来排列，这样可以适用多种数据类型和数值。主要就是进位函数，构想很简单，比如5个数排列，就好象从12345 to 54321的循环，进位函数就是对已经排列过的数组下标进行累加，实现逢5进1，同时过滤掉重复数字...

Option Explicit

'全排列个数
Function GetPermNum(ByVal M As Long) As Long
Dim i As Long
For i = M - 1 To 1 Step -1
M = M * i
Next
GetPermNum = M
End Function

'进位
Sub PermCarry(Index() As Long, Length As Long, bolExist() As Boolean)
'Index:要排列的数组的下标，Length数组最大下标，bolExist标志当前使用的下标
Dim Idx As Long

Idx = Length
bolExist(Index(Idx)) = False
Do
Index(Idx) = Index(Idx) + 1
If Index(Idx) > Length Then
Idx = Idx - 1
bolExist(Index(Idx)) = False
Else
If Not bolExist(Index(Idx)) Then
bolExist(Index(Idx)) = True
Exit Do
End If
End If
Loop
Do While Idx < Length
Idx = Idx + 1
Index(Idx) = 0
Do While bolExist(Index(Idx))
Index(Idx) = Index(Idx) + 1
Loop
bolExist(Index(Idx)) = True
Loop

End Sub

'输出单个排列的结果
Function GetResultItem(arr As Variant, Index() As Long) As String

Dim i As Long
ReDim tmp(UBound(Index))
For i = 0 To UBound(tmp)
tmp(i) = arr(Index(i))
Next
GetResultItem = Join(tmp)

End Function

Sub GetResult(arr As Variant, Result As Variant)

Dim i As Long
Dim n As Long, Length As Long
Dim Index() As Long
Dim bolExist() As Boolean

Length = UBound(arr)
ReDim Index(Length)
ReDim bolExist(Length)
For i = 0 To Length
Index(i) = i
bolExist(i) = True
Next

n = GetPermNum(Length + 1)
ReDim Result(n - 1)
Result(0) = GetResultItem(arr, Index)
For i = 1 To n - 1
PermCarry Index, Length, bolExist
Result(i) = GetResultItem(arr, Index)
'DoEvents
Next

End Sub

Private Sub Command1_Click()

Dim arr, Result
arr = Array("A", "B", "C")
GetResult arr, Result
Debug.Print Join(Result, vbCrLf)

End Sub

Answer 3

Private Sub Form_Click()
arr = GetPArr(4)
For i = 0 To UBound(arr, 2)
For j = 0 To UBound(arr, 1)
Print arr(j, i);
Next j
Print
Next i
End Sub

Public Function GetPArr(ByVal m As Integer)
Dim arr() As Byte
Dim a As Long
Dim i, j, k, n

ReDim arr(m - 1, 0)
For i = 0 To m - 1
arr(i, 0) = i + 1
Next i

For n = 2 To m
ReDim Preserve arr(m - 1, n * (a + 1) - 1)
For i = 0 To a
For k = 1 To n - 1
a = a + 1
For j = 0 To n - k - 2
arr(j, a) = arr(j, i)
Next j
arr(n - k - 1, a) = arr(n - 1, i)
For j = n - k To n - 1
arr(j, a) = arr(j - 1, i)
Next j
For j = n To m - 1
arr(j, a) = arr(j, i)
Next j
Next k
Next i
Next n
GetPArr = arr
End Function

Answer 4

basic 忘得一干二净，只有算法没忘，冒泡一个给你吧
for i=1 to n-1
for j=i+1 to n
if a[i]>a[j] then......... 不记得了，拿二分好了