Excel·VBA二维数组组合函数、组合求和

1，二维数组组合函数

代码思路，类似之前的文章“VBA排列函数”尾数循环的方式

Function combin_arr2d(arr)'arr二维数组，内含m行*n列元素，每行抽取1个进行组合，返回一维嵌套数组，每行为一个组合(数组从1开始计数)Dim i&, j&, m&, n&, kk&, result, k&, x&, r&If LBound(arr) = 0 Or LBound(arr, 2) = 0 Then  '转为从1开始计数arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))End Ifm = UBound(arr): n = UBound(arr, 2): ReDim b&(1 To m - 1)kk = n ^ m: ReDim result(1 To kk): ReDim res(1 To m): k = 1For i = 1 To m - 1  '非尾数部分初始值b(i) = 1NextDoFor i = k To m - 1  '非尾数部分res(i) = arr(i, b(i))NextFor j = 1 To n  '仅修改尾数res(m) = arr(m, j): r = r + 1: result(r) = resNextx = m - 1: b(x) = b(x) + 1  '尾数循环结束后，m-1位进位Do While b(x) > n  '循环进位，原位重新为1If x > 1 Then b(x) = 1: x = x - 1: b(x) = b(x) + 1 Else Exit DoLoopk = x  '非尾数部分，需要重新赋值的开始位置If b(1) > n Then Exit Do   '所有组合完成Loop Until r = kkcombin_arr2d = result
End Function

举例

组合结果为一维嵌套数组，写入表格需转为二维数组，以下代码调用了TransposeArr函数，代码详见《Excel·VBA数组行列转换函数》（如需使用代码需复制）

Sub combin_arr2d组合输出()Dim arr, brr, crrarr = [a1].CurrentRegionbrr = combin_arr2d(arr)  '调用函数返回组合，一维嵌套数组crr = TransposeArr(brr, 2)  '转为二维数组Cells(1, "e").Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub

对表格中A1：C5区域共5行3列，每行抽取每行抽取1个元素进行组合，共有3 ^ 5 = 243个组合，如图（部分截图）
在这里插入图片描述

2，组合求和

Sub combin_arr2d组合求和()Dim arr, brr, b, h, h2, i&, temp_sum, write_col$, w&
'--------------------参数填写：arr二维数组，h和值下限，h2和值上限，write_col结果写入列号arr = [a1:c14]: h = 36: h2 = 43write_col = "e": w = 1: Cells(w, write_col).Resize(1, 2) = Array("和值", "组合")tm = Timer: brr = combin_arr2d(arr)  '调用函数返回组合，一维嵌套数组For Each b In brrtemp_sum = WorksheetFunction.sum(b)If Abs(Round(temp_sum - h, 6)) < (0.1 ^ 6) Or Abs(Round(temp_sum - h2, 6)) < (0.1 ^ 6) _Or (temp_sum >= h And temp_sum <= h2) Thenw = w + 1: Cells(w, write_col).Resize(1, 2) = Array(temp_sum, Join(b, "+"))End IfNextDebug.Print "组合求和完成，累计用时：" & Format(Timer - tm, "0.00")  '耗时
End Sub