Excel·VBA二维数组组合函数的应用实例

看到一个问题《关于#穷举#的问题,如何解决?(语言-开发语言)》,对同一个数据存在"是/否"2种状态,判断其是否参与计算,并输出一系列数据的"是/否"状态的结果

目录

方法1:二维数组组合函数

之前的文章《Excel·VBA二维数组组合函数、组合求和》,可以对A-B列每行选择一种状态,返回所有状态的组合,对"原值"依次累加C-D列数值,判断是否符合F2:F3所需结果。以下代码调用了combin_arr2d函数,如需使用代码需复制

vbnet 复制代码
Sub 穷举开关状态1()
    Dim arr, c, d, v, v1, v2, brr, b, sum1, sum2, write_col&, i&
    arr = [a2:b9]: v = [f1]: v1 = [f2]: v2 = [f3]
    write_col = 8  '输出结果写入起始列号
    c = [c2].Resize(8, 1): c = WorksheetFunction.Transpose(c)  '单列转一维数组
    d = [d2].Resize(8, 1): d = WorksheetFunction.Transpose(d): tm = Timer
    brr = combin_arr2d(arr)  '调用函数返回组合,一维嵌套数组
    For Each b In brr
        sum1 = v: sum2 = v
        For i = 1 To UBound(b)
            If b(i) = "是" Then
                If Len(c(i)) Then sum1 = Application.Evaluate(sum1 & CStr(c(i)))
                If Len(d(i)) Then sum2 = Application.Evaluate(sum2 & CStr(d(i)))
            End If
        Next
        If Abs(Round(sum1 - v1, 6)) < (0.1 ^ 6) And Abs(Round(sum2 - v2, 6)) < (0.1 ^ 6) Then
            Cells(2, write_col).Resize(UBound(b), 1) = WorksheetFunction.Transpose(b)
            write_col = write_col + 1
        End If
    Next
    Debug.Print "累计用时:" & Format(Timer - tm, "0.00")  '耗时
End Sub

注意:从上到下运算累计计算结果,并非将计算式叠加后一次性计算结果

结果

方法2:二进制数

开关只有"是/否"2种状态,那么也可以用0和1表示,这与二进制数一样,之前的文章《python从数组中找出所有和为M的组合》,采用过这种方法查找组合求和的结果,那么本问题也可尝试

n个元素的全组合总数=2 ^ n,故8个元素的全组合数为256个,即0-255转化为二进制数(例如255的二进制数为"11111111",表示8个元素全部选择)

vbnet 复制代码
Sub 穷举开关状态2()
    Dim c, d, v, v1, v2, s$, s1$, sum1, sum2, write_col&, i&, x&
    v = [f1]: v1 = [f2]: v2 = [f3]: Dim res(1 To 8)
    write_col = 8  '输出结果写入起始列号
    c = [c2].Resize(8, 1): c = WorksheetFunction.Transpose(c)  '单列转一维数组
    d = [d2].Resize(8, 1): d = WorksheetFunction.Transpose(d): tm = Timer
    For x = 1 To 2 ^ 8 - 1  '注意-512 < x < 511
        s = CStr(WorksheetFunction.Dec2Bin(x)): s = Format(s, "00000000")
        sum1 = v: sum2 = v
        For i = 1 To Len(s)
            s1 = Mid(s, i, 1): res(i) = IIf(s1 = "1", "是", "否")
            If s1 = "1" Then
                If Len(c(i)) Then sum1 = Application.Evaluate(sum1 & CStr(c(i)))
                If Len(d(i)) Then sum2 = Application.Evaluate(sum2 & CStr(d(i)))
            End If
        Next
        If Abs(Round(sum1 - v1, 6)) < (0.1 ^ 6) And Abs(Round(sum2 - v2, 6)) < (0.1 ^ 6) Then
            Cells(2, write_col).Resize(UBound(res), 1) = WorksheetFunction.Transpose(res)
            write_col = write_col + 1
        End If
    Next
End Sub

此种方法不足之处:十进制转二进制Dec2Bin函数,取值范围太小,超过511就不适用;元素个数变化时需要修改第3、5-8行的代码,较为麻烦

结果

同样的原始数据,输出结果相同,但顺序不同

相关推荐
码尚云标签25 分钟前
导入Excel打印
excel·excel导入·标签打印软件·打印知识·excel导入打印教程
lilv6617 小时前
python中用xlrd、xlwt读取和写入Excel中的日期值
开发语言·python·excel
大虫小呓1 天前
14天搞定Excel公式:告别加班,效率翻倍!
excel·excel 公式
瓶子xf2 天前
EXCEL-业绩、目标、达成、同比、环比一图呈现
excel
码尚云标签2 天前
批量打印Excel条形码
excel·标签打印·条码打印·一维码打印·条码批量打印·标签打印软件·打印教程
Wangsk1333 天前
用 Python 批量处理 Excel:从重复值清洗到数据可视化
python·信息可视化·excel·pandas
叶甯3 天前
【Excel】vlookup使用小结
excel
AI手记叨叨3 天前
Python分块读取大型Excel文件
python·excel
专注VB编程开发20年3 天前
用ADO操作EXCEL文件创建表格,删除表格CREATE TABLE,DROP TABLE
服务器·windows·excel·ado·创建表格·删除表格·读写xlsx
_oP_i3 天前
wps创建编辑excel customHeight 属性不是标准 Excel Open XML导致比对异常
xml·excel·wps