Excel·VBA数组排列函数
目录
- 1，组合代码思路
- 2，VBA数组排列函数
- 3，VBA数组重复排列函数
上一篇文章《Excel·VBA数组组合函数、组合求和》，实现了VBA组合功能，本文为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 If
m = 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 Then
For i = 1 To m
result(i) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(Array(arr(i))))
Next
permut_arr = result: Exit Function
End If
For i = 1 To m 'arr初始位置brr
brr(i) = i
Next
Do
For i = 1 To n - 1 'b非尾数部分
b(i) = brr(i)
Next
For j = n To m '仅修改尾数
b(n) = brr(j)
For k = 1 To n
res(k) = arr(b(k))
Next
r = r + 1: result(r) = res
Next
x = 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) > m
If 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 Do
y = Application.Match(brr(x), brr, 0)
Loop
If brr(1) > m Then Exit Do '所有排列完成
For i = 1 To m '对brr数组x之后的按顺序赋值
exist = False '初始为不存在
For j = 1 To x
If brr(j) = i Then exist = True: Exit For
Next
If exist = False And x < m Then x = x + 1: brr(x) = i
Next
Loop Until r = kk
permut_arr = result
End Function
注意：代码中“排列个数”kk定义为Long类型，故最大值为2,147,483,647，如果实际应用中会超过该值的，需修改数据类型
Sub permut_arr测试()
Dim arr, brr
tm = Timer
arr = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
brr = permut_arr(arr, 6)
For Each b In brr
r = r + 1: Cells(r, "a").Resize(1, UBound(b)) = b
Next
Debug.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 If
m = 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) = 1
Next
Do
For i = 1 To n
res(i) = arr(b(i))
Next
r = r + 1: result(r) = res
x = 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) + 1
Loop
Loop Until r = kk
permut_repet = result
End Function
注意：代码中“排列个数”kk定义为Long类型，故最大值为2,147,483,647，如果实际应用中会超过该值的，需修改数据类型
Sub permut_repet测试()
Dim arr, brr
tm = Timer
arr = Array(1, 2, 3, 4, 5)
brr = permut_repet(arr, 3)
For Each b In brr
r = r + 1: Cells(r, "a").Resize(1, UBound(b)) = b
Next
Debug.Print ("所有重复排列写入完成，用时：" & Format(Timer - tm, "0.00"))
End Sub
从1-5共5个数字中重复选出3个数字，共125种排列，如图（部分截图）
