Excel·VBA数组排列函数

《百度百科-排列》
排列：从n个不同元素中，取出m（m≤n）个元素，按照一定的顺序排成一列，叫做从n个元素中取出m个元素的一个排列，一般称作选排列；当m=n时，这个排列被称作全排列
排列数：从n个不同元素中取出m个不同元素的所有不同排列的个数称为排列种数或称排列数
排列个数公式：P(n,m) = n!/(n-m)!，当n=m即全排列时为P(n) = n!

1，排列代码思路

从1-5共5个数字中选出4个数字，共120种排列，如图（部分截图）

按照上一篇文章“VBA组合函数”尾数循环的方式，观察每个排列的数字排列规律，可以发现每次尾数循环结束后，倒数第2列（即m-1）即进位+1（即2-3行）；当进位列的数字达到最大值（即n）时，继续向前1列（即m-2）进位+1（即6-7行）；当进位后的数字在之前出现过时，数字继续递增+1（即8-9行）；进位结束后，排列在进位点之前的数字不变，之后的数字，按照1-5的顺序填入，且数字不重复；如此循环直至完成120种排列

VBA代码如下

2，VBA数组排列函数

选排列、全排列

Function permut_arr(arr, n&)'arr一维数组，内含m个元素，抽取n个进行排列，返回一维嵌套数组，每行为一个排列(数组从1开始计数)Dim i&, j&, k&, m&, kk&, result, x&, r&If LBound(arr) = 0 Then  '转为从1开始计数arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))End Ifm = UBound(arr) - LBound(arr) + 1: ReDim brr&(1 To m): ReDim b&(1 To n)kk = Application.permut(m, n): ReDim result(1 To kk): ReDim res(1 To n)If n = 1 ThenFor i = 1 To mresult(i) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Array(arr(i))))Nextpermut_arr = result: Exit FunctionEnd IfFor i = 1 To m  'arr初始位置brrbrr(i) = iNextDoFor i = 1 To n - 1  'b非尾数部分b(i) = brr(i)NextFor j = n To m   '仅修改尾数b(n) = brr(j)For k = 1 To nres(k) = arr(b(k))Nextr = r + 1: result(r) = resNextx = n - 1: brr(x) = brr(x) + 1  '尾数循环结束后，n-1位进位y = Application.Match(brr(x), brr, 0)Do While (TypeName(y) <> "Error" And y < x) Or brr(x) > mIf y < x Then brr(x) = brr(x) + 1  '进位后，如之前位有重复值的继续+1'循环进位，直至完成所有进位If brr(x) > m Then If x > 1 Then x = x - 1: brr(x) = brr(x) + 1 Else Exit Doy = Application.Match(brr(x), brr, 0)LoopIf brr(1) > m Then Exit Do  '所有排列完成For i = 1 To m     '对brr数组x之后的按顺序赋值exist = False  '初始为不存在For j = 1 To xIf brr(j) = i Then exist = True: Exit ForNextIf exist = False And x < m Then x = x + 1: brr(x) = iNextLoop Until r = kkpermut_arr = result
End Function

注意：代码中“排列个数”kk定义为Long类型，故最大值为2,147,483,647，如果实际应用中会超过该值的，需修改数据类型

Sub permut_arr测试()Dim arr, brrtm = Timerarr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)brr = permut_arr(arr, 6)For Each b In brrr = r + 1: Cells(r, "a").Resize(1, UBound(b)) = bNextDebug.Print ("所有选排列写入完成，用时：" & Format(Timer - tm, "0.00"))
'--------------------转二维数组写入
'    tm = Timer
'    arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
'    brr = TransposeArr(permut_arr(arr, 6), 2)  '调用函数，将一维嵌套数组转为二维数组
'    Cells(1, "a").Resize(UBound(brr), UBound(brr, 2)) = brr
'    Debug.Print ("所有选排列写入完成，用时：" & Format(Timer - tm, "0.00"))  '耗时
End Sub

注意：测试中调用了TransposeArr函数，将一维嵌套数组转为二维数组输出，代码详见《Excel·VBA数组组合函数、组合求和》

测试在excel表格中输出0-9共10个数字选6的排列形式，共151200种排列，输出结果与python的结果完全一致
python排列：《python排列组合函数》

3种输出排列方式耗时对比：151200种排列耗时秒数

python排列	VBA排列一维嵌套数组	VBA排列一维嵌套数组转二维数组
15.5	5.16	1.46

可以看出，VBA排列输出一维嵌套数组2种写入方式都是非常快的

3，VBA数组重复排列函数

重复排列，相比上面的“选排列”和“全排列”是一种特殊的排列
重复排列：从n个不同元素中可重复地选取m个元素，按照一定的顺序排成一列，称作从n个元素中取m个元素的可重复排列
重复排列个数公式：n ^ m
代码思路：重复排列由于元素可重复使用，因而代码思路类似“选排列”，但仅考虑进位无需判断是否重复，仅原位置重置即可，故此代码较为简单（与10进制数字进位类似）

Function permut_repet(arr, n&)'arr一维数组，内含m个元素，重复抽取n个进行排列，返回一维嵌套数组，每行为一个排列(数组从1开始计数)Dim i&, m&, kk&, result, x&, r&If LBound(arr) = 0 Then  '转为从1开始计数arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))End Ifm = UBound(arr) - LBound(arr) + 1: ReDim b&(1 To n)kk = m ^ n: ReDim result(1 To kk): ReDim res(1 To n)For i = 1 To n  '临时位置，index初始值b(i) = 1NextDoFor i = 1 To nres(i) = arr(b(i))Nextr = r + 1: result(r) = resx = n: b(x) = b(x) + 1   '修改尾数；当尾数循环结束后，进位Do While b(x) > m        '进位，b中元素的最大值是m，从后向前判断b(x) = 1: x = x - 1  '尾数重置，进位If x = 0 Then Exit Do  '完成所有排列b(x) = b(x) + 1LoopLoop Until r = kkpermut_repet = result
End Function

注意：代码中“排列个数”kk定义为Long类型，故最大值为2,147,483,647，如果实际应用中会超过该值的，需修改数据类型

Sub permut_repet测试()Dim arr, brrtm = Timerarr = Array(1, 2, 3, 4, 5)brr = permut_repet(arr, 3)For Each b In brrr = r + 1: Cells(r, "a").Resize(1, UBound(b)) = bNextDebug.Print ("所有重复排列写入完成，用时：" & Format(Timer - tm, "0.00"))
End Sub

从1-5共5个数字中重复选出3个数字，共125种排列，如图（部分截图）