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数组组合函数、组合求和》慢了很多

相关推荐
码尚云标签27 分钟前
导入Excel打印
excel·excel导入·标签打印软件·打印知识·excel导入打印教程
星期天要睡觉1 小时前
机器学习——支持向量机(SVM)
算法·机器学习·支持向量机·svm
已读不回1431 小时前
LRU算法在前端性能优化中的实践艺术(缓存请求函数为例)
javascript·算法
大熊背2 小时前
基于人眼视觉特性的相关图像增强基础知识介绍
人工智能·算法·计算机视觉
啊阿狸不会拉杆2 小时前
《算法导论》第 12 章 - 二叉搜索树
数据结构·c++·算法·排序算法
范特西_2 小时前
不同的子序列-二维动态规划
算法·动态规划
花开富贵ii3 小时前
代码随想录算法训练营第三十八天、三十九天|动态规划part11、12
java·数据结构·算法·leetcode·动态规划
HW-BASE8 小时前
《C语言》指针练习题--1
c语言·开发语言·单片机·算法·c
泽虞8 小时前
数据结构与算法
c语言·数据结构·算法
max5006009 小时前
深度学习的视觉惯性里程计(VIO)算法优化实践
人工智能·深度学习·算法