非递归实现不重复序列的全排列(二)
下面给出一个回溯算法的代码,在VertyNew(华) 网友提供代码(http://community.csdn.net/Expert/topic/2909/2909080.xml?temp=.9990503)基础上稍作修改:
Sub pailie2(ParamArray x())
Dim starttime As Single, endtime As Single
Dim i As Integer, j As Integer, Num As Long, n As Integer
Dim a() As Integer '记载数组下标
Dim b() As Integer '记载使用标识
n = UBound(x) + 1
starttime = Timer '开始计时
ReDim a(1 To n)
ReDim b(1 To n)
i = 1
a(1) = 0
Do While i <= n
?? a(i) = a(i) + 1
?? If a(i) <= n Then
????? If b(a(i)) = 0 Then
???????? If i = n Then '达到数组末,则输出组合情况
???????????? For j = 1 To n
????????????? Debug.Print x(a(j) - 1) & " ";?'输出
???????????? Next
??????????? Debug.Print
??????????? Num = Num + 1
???????????? i = i - 1
???????????? b(a(i)) = 0 '清空使用标识
????????? Else
???????????? b(a(i)) = 1 '标记已使用
???????????? i = i + 1
???????????? a(i) = 0 '重查
????????? End If
????? End If
?? Else
????? i = i - 1
????? If i = 0 Then Exit Do '回溯至数组前则结束
????? b(a(i)) = 0
?? End If
?? DoEvents
Loop
endtime = Timer
Debug.Print "共 " & Num & " 种排列!用时 " & endtime - starttime & " 秒!"
End Sub
Private Sub Command1_Click()
pailie2 "a", "b", "c", "d", "e", "f", "g"
End Sub