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

目录

之前的文章《Excel·VBA数组组合函数、组合求和》《Excel·VBA数组排列函数》,都是针对一维数组 的组合和排列

二维数组组合:对一个m行*n列的二维数组,每行抽取1个元素进行组合,则共有n ^ m个组合

1,二维数组组合函数

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

vbnet 复制代码
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 If
    m = 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 = 1
    For i = 1 To m - 1  '非尾数部分初始值
        b(i) = 1
    Next
    Do
        For i = k To m - 1  '非尾数部分
            res(i) = arr(i, b(i))
        Next
        For j = 1 To n  '仅修改尾数
            res(m) = arr(m, j): r = r + 1: result(r) = res
        Next
        x = m - 1: b(x) = b(x) + 1  '尾数循环结束后,m-1位进位
        Do While b(x) > n  '循环进位,原位重新为1
            If x > 1 Then b(x) = 1: x = x - 1: b(x) = b(x) + 1 Else Exit Do
        Loop
        k = x  '非尾数部分,需要重新赋值的开始位置
        If b(1) > n Then Exit Do   '所有组合完成
    Loop Until r = kk
    combin_arr2d = result
End Function

举例

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

vbnet 复制代码
Sub combin_arr2d组合输出()
    Dim arr, brr, crr
    arr = [a1].CurrentRegion
    brr = 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,组合求和

vbnet 复制代码
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 = 43
    write_col = "e": w = 1: Cells(w, write_col).Resize(1, 2) = Array("和值", "组合")
    tm = Timer: brr = combin_arr2d(arr)  '调用函数返回组合,一维嵌套数组
    For Each b In brr
        temp_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) Then
            w = w + 1: Cells(w, write_col).Resize(1, 2) = Array(temp_sum, Join(b, "+"))
        End If
    Next
    Debug.Print "组合求和完成,累计用时:" & Format(Timer - tm, "0.00")  '耗时
End Sub

对表格中A1:C14区域共14行3列,进行组合共有3 ^ 14 = 4,782,969 个组合,求和值范围为36-43的所有组合,共有525,087个组合符合要求,如图(部分截图)

测试耗时秒数

组合类型 一维数组组合 二维数组组合
组合个数 5,242,887 4,782,969
耗时秒数 2.67 60.61

组合求和的代码运行速度较《Excel·VBA数组组合函数、组合求和》慢了很多

相关推荐
爱吃生蚝的于勒9 分钟前
深入学习指针(5)!!!!!!!!!!!!!!!
c语言·开发语言·数据结构·学习·计算机网络·算法
羊小猪~~12 分钟前
数据结构C语言描述2(图文结合)--有头单链表,无头单链表(两种方法),链表反转、有序链表构建、排序等操作,考研可看
c语言·数据结构·c++·考研·算法·链表·visual studio
一名技术极客14 分钟前
Vue2 doc、excel、pdf、ppt、txt、图片以及视频等在线预览
pdf·powerpoint·excel·文件在线预览
用余生去守护33 分钟前
【反射率】-- Lab 转换(excel)
excel
进击的六角龙34 分钟前
Python中处理Excel的基本概念(如工作簿、工作表等)
开发语言·python·excel
TracyDemo34 分钟前
excel功能
excel
lc寒曦35 分钟前
【VBA实战】用Excel制作排序算法动画
排序算法·excel·vba
王哈哈^_^37 分钟前
【数据集】【YOLO】【VOC】目标检测数据集,查找数据集,yolo目标检测算法详细实战训练步骤!
人工智能·深度学习·算法·yolo·目标检测·计算机视觉·pyqt
zzzgd81638 分钟前
easyexcel实现自定义的策略类, 最后追加错误提示列, 自适应列宽,自动合并重复单元格, 美化表头
java·excel·表格·easyexcel·导入导出
努力学习技能的LY38 分钟前
Excel:vba实现批量插入图片批注
excel