回溯实现数字的排列组合

从1--m中选n个数字的排列组合的简单实现,速度还可以:

Sub getall(ByVal m As Byte, ByVal n As Byte, Optional types As Byte = 0)'types=0为排列 types=1 为组合
Dim num As Long, i As Integer, k As Integer, a(), s() As String
ReDim a(1 To n)
k = 1
Do
a(k) = a(k) + 1
If a(k) > m Then
k = k - 1
Else
For i = 1 To k - 1
If a(k) = a(i) Then Exit For
Next
If i = k Then
If k = n Then
num = num + 1
ReDim Preserve s(1 To num)
s(num) = Join(a, ",")
End If
If k < n Then k = k + 1: a(k) = a(k - 1) * types

End If
End If
Loop Until k = 0
Debug.Print Join(s, vbTab)
End Sub

Sub getit()
getall 8, 3, 1 '组合
Debug.Print
getall 8, 3 '排列
End Sub

返回:

1,2,3 1,2,4 1,2,5 1,2,6 1,2,7 1,2,8 1,3,4 1,3,5 1,3,6 1,3,7 1,3,8 1,4,5 1,4,6 1,4,7 1,4,8 1,5,6 1,5,7 1,5,8 1,6,7 1,6,8 1,7,8 2,3,4 2,3,5 2,3,6 2,3,7 2,3,8 2,4,5 2,4,6 2,4,7 2,4,8 2,5,6 2,5,7 2,5,8 2,6,7 2,6,8 2,7,8 3,4,5 3,4,6 3,4,7 3,4,8 3,5,6 3,5,7 3,5,8 3,6,7 3,6,8 3,7,8 4,5,6 4,5,7 4,5,8 4,6,7 4,6,8 4,7,8 5,6,7 5,6,8 5,7,8 6,7,8

1,2,3 1,2,4 1,2,5 1,2,6 1,2,7 1,2,8 1,3,2 1,3,4 1,3,5 1,3,6 1,3,7 1,3,8 1,4,2 1,4,3 1,4,5 1,4,6 1,4,7 1,4,8 1,5,2 1,5,3 1,5,4 1,5,6 1,5,7 1,5,8 1,6,2 1,6,3 1,6,4 1,6,5 1,6,7 1,6,8 1,7,2 1,7,3 1,7,4 1,7,5 1,7,6 1,7,8 1,8,2 1,8,3 1,8,4 1,8,5 1,8,6 1,8,7 2,1,3 2,1,4 2,1,5 2,1,6 2,1,7 2,1,8 2,3,1 2,3,4 2,3,5 2,3,6 2,3,7 2,3,8 2,4,1 2,4,3 2,4,5 2,4,6 2,4,7 2,4,8 2,5,1 2,5,3 2,5,4 2,5,6 2,5,7 2,5,8 2,6,1 2,6,3 2,6,4 2,6,5 2,6,7 2,6,8 2,7,1 2,7,3 2,7,4 2,7,5 2,7,6 2,7,8 2,8,1 2,8,3 2,8,4 2,8,5 2,8,6 2,8,7 3,1,2 3,1,4 3,1,5 3,1,6 3,1,7 3,1,8 3,2,1 3,2,4 3,2,5 3,2,6 3,2,7 3,2,8 3,4,1 3,4,2 3,4,5 3,4,6 3,4,7 3,4,8 3,5,1 3,5,2 3,5,4 3,5,6 3,5,7 3,5,8 3,6,1 3,6,2 3,6,4 3,6,5 3,6,7 3,6,8 3,7,1 3,7,2 3,7,4 3,7,5 3,7,6 3,7,8 3,8,1 3,8,2 3,8,4 3,8,5 3,8,6 3,8,7 4,1,2 4,1,3
4,1,5 4,1,6 4,1,7 4,1,8 4,2,1 4,2,3 4,2,5 4,2,6 4,2,7 4,2,8 4,3,1 4,3,2 4,3,5 4,3,6 4,3,7 4,3,8 4,5,1 4,5,2 4,5,3 4,5,6 4,5,7 4,5,8 4,6,1 4,6,2 4,6,3 4,6,5 4,6,7 4,6,8 4,7,1 4,7,2 4,7,3 4,7,5 4,7,6 4,7,8 4,8,1 4,8,2 4,8,3 4,8,5 4,8,6 4,8,7 5,1,2 5,1,3 5,1,4 5,1,6 5,1,7 5,1,8 5,2,1 5,2,3 5,2,4 5,2,6 5,2,7 5,2,8 5,3,1 5,3,2 5,3,4 5,3,6 5,3,7 5,3,8 5,4,1 5,4,2 5,4,3 5,4,6 5,4,7 5,4,8 5,6,1 5,6,2 5,6,3 5,6,4 5,6,7 5,6,8 5,7,1 5,7,2 5,7,3 5,7,4 5,7,6 5,7,8 5,8,1 5,8,2 5,8,3 5,8,4 5,8,6 5,8,7 6,1,2 6,1,3 6,1,4 6,1,5 6,1,7 6,1,8 6,2,1 6,2,3 6,2,4 6,2,5 6,2,7 6,2,8 6,3,1 6,3,2 6,3,4 6,3,5 6,3,7 6,3,8 6,4,1 6,4,2 6,4,3 6,4,5 6,4,7 6,4,8 6,5,1 6,5,2 6,5,3 6,5,4 6,5,7 6,5,8 6,7,1 6,7,2 6,7,3 6,7,4 6,7,5 6,7,8 6,8,1 6,8,2 6,8,3 6,8,4 6,8,5 6,8,7 7,1,2 7,1,3 7,1,4 7,1,5
7,1,6 7,1,8 7,2,1 7,2,3 7,2,4 7,2,5 7,2,6 7,2,8 7,3,1 7,3,2 7,3,4 7,3,5 7,3,6 7,3,8 7,4,1 7,4,2 7,4,3 7,4,5 7,4,6 7,4,8 7,5,1 7,5,2 7,5,3 7,5,4 7,5,6 7,5,8 7,6,1 7,6,2 7,6,3 7,6,4 7,6,5 7,6,8 7,8,1 7,8,2 7,8,3 7,8,4 7,8,5 7,8,6 8,1,2 8,1,3 8,1,4 8,1,5 8,1,6 8,1,7 8,2,1 8,2,3 8,2,4 8,2,5 8,2,6 8,2,7 8,3,1 8,3,2 8,3,4 8,3,5 8,3,6 8,3,7 8,4,1 8,4,2 8,4,3 8,4,5 8,4,6 8,4,7 8,5,1 8,5,2 8,5,3 8,5,4 8,5,6 8,5,7 8,6,1 8,6,2 8,6,3 8,6,4 8,6,5 8,6,7 8,7,1 8,7,2 8,7,3 8,7,4 8,7,5 8,7,6