Excel·VBA定量装箱、凑数值金额、组合求和问题

在这里插入图片描述
如图:对图中A-C列数据,根据C列数量按照一定的取值范围,组成一个分组装箱,要求如下:
1,每箱数量最好凑足50,否则为47-56之间;
2,图中每行数据不得拆分;
3,按顺序对分组装箱结果进行编号,如D列中BS0001;
4,生成分组装箱结果(包含B-C列数据),以及单独生成最终无法装箱的数据

目录

    • 实现方法1
    • 实现方法2
    • 实现方法3
      • 3种实现方法生成结果、对比、耗时
    • 装箱结果整理
      • 编号无序
      • 编号有序

本问题本质上是组合求和问题,调用了combin_arr1函数,代码详见《Excel·VBA数组组合函数、组合求和》(如需使用代码需复制)

实现方法1

代码思路:持续不断组合
1,对数据读取为字典,行号为键数量为值;
2,对行号数组从2-N依次进行组合,判断是否符合取值范围;
3,对符合取值范围的行号组合,在res数组对应行号中写入装箱编号,并在字典中删除该行号
4,删除行号后,跳出后续循环遍历,并重复步骤2-3,直至无法删除行号,即没有符合范围的行号组合
5,在D列写入对应的装箱编号
注意:由于步骤4需要跳出循环,所以无法使用for…each遍历组合数组,否则报错该数组被固定或暂时锁定

Sub 装箱问题1()Dim arr, dict As Object, i&, j&, temp_sum, res, w&, dc&, brr, r&, c&target = 50: trr = Array(47, 56)  '目标值,范围Set dict = CreateObject("scripting.dictionary"): tm = TimerWith Worksheets("数据")  '读取数据arr = .[a1].CurrentRegion: ReDim res(1 To UBound(arr)): res(1) = "箱号"For i = 2 To UBound(arr)If arr(i, 3) = target Thenw = w + 1: res(i) = "BS" & Format(w, "000")Elsedict(i) = arr(i, 3)End IfNextdc = dict.CountDo    '2层do方便有符合目标值时跳出,并继续组合DoFor j = 2 To dcbrr = combin_arr1(dict.keys, j)For r = 1 To UBound(brr)temp_sum = 0For c = 1 To UBound(brr(r))temp_sum = temp_sum + dict(brr(r)(c))NextIf temp_sum >= trr(0) And temp_sum <= trr(1) Thenw = w + 1For c = 1 To UBound(brr(r))res(brr(r)(c)) = "BS" & Format(w, "000"): dict.Remove brr(r)(c)  '写入箱号,删除行号NextExit DoEnd IfNextNextIf dc = dict.Count Then Exit Do  '无组合符合目标值,跳出Loop Until dc = 0If dc = dict.Count Then Exit Dodc = dict.CountLoop Until dc = 0.[d1].Resize(UBound(res), 1) = WorksheetFunction.Transpose(res)End WithDebug.Print "组合完成,累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

实现方法2

代码思路:遍历组合,跳过重复行号
与实现方法2类似,但步骤4不同,在字典删除行号后,继续遍历组合,并判断每个组合中是否存在被删除的行号,如果存在则跳过本组合,直至无法删除行号,或剩余行号无法支持下一轮递增元素个数进行组合

Sub 装箱问题2()Dim arr, dict As Object, i&, j&, temp_sum, res, w&, dc&, brr, r&, c&target = 50: trr = Array(47, 56)  '目标值,范围Set dict = CreateObject("scripting.dictionary"): tm = TimerWith Worksheets("数据")  '读取数据arr = .[a1].CurrentRegion: ReDim res(1 To UBound(arr)): res(1) = "箱号"For i = 2 To UBound(arr)If arr(i, 3) = target Thenw = w + 1: res(i) = "BS" & Format(w, "000")Elsedict(i) = arr(i, 3)End IfNextFor j = 2 To dict.CountIf j > dict.Count Then Exit For  '所剩元素不足,结束brr = combin_arr1(dict.keys, j)For Each b In brrtemp_sum = 0For Each bb In bIf Not dict.Exists(bb) Thentemp_sum = 0: Exit For  '重复跳过Elsetemp_sum = temp_sum + dict(bb)End IfNextIf temp_sum >= trr(0) And temp_sum <= trr(1) Thenw = w + 1For Each bb In bres(bb) = "BS" & Format(w, "000"): dict.Remove bb  '写入箱号,删除行号NextEnd IfNextNext.[d1].Resize(UBound(res), 1) = WorksheetFunction.Transpose(res)End WithDebug.Print "组合完成,累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

实现方法3

实现方法1和实现方法2,都没有满足要求中“每箱数量最好凑足50”,仅对每行数量优先判断是否等于50,对于后续组合中都是符合范围即可
因此,对实现方法2添加1个for循环,第1遍组合满足target,第2遍组合满足目标值trr范围

Sub 装箱问题3()Dim arr, dict As Object, i&, j&, temp_sum, res, w&, dc&, brr, r&, c&target = 50: trr = Array(47, 56)  '目标值,范围Set dict = CreateObject("scripting.dictionary"): tm = TimerWith Worksheets("数据")  '读取数据arr = .[a1].CurrentRegion: ReDim res(1 To UBound(arr)): res(1) = "箱号"For i = 2 To UBound(arr)If arr(i, 3) = target Thenw = w + 1: res(i) = "BS" & Format(w, "000")Elsedict(i) = arr(i, 3)End IfNextFor n = 1 To 2  '第1遍组合满足target,第2遍组合满足目标值trr范围For j = 2 To dict.CountIf j > dict.Count Then Exit For  '所剩元素不足,结束brr = combin_arr1(dict.keys, j)For Each b In brrtemp_sum = 0For Each bb In bIf Not dict.Exists(bb) Thentemp_sum = 0: Exit For  '重复跳过Elsetemp_sum = temp_sum + dict(bb)End IfNextIf n = 1 And temp_sum = target Thenw = w + 1For Each bb In bres(bb) = "BS" & Format(w, "000"): dict.Remove bb  '写入箱号,删除行号NextElseIf n = 2 And temp_sum >= trr(0) And temp_sum <= trr(1) Thenw = w + 1For Each bb In bres(bb) = "BS" & Format(w, "000"): dict.Remove bb  '写入箱号,删除行号NextEnd IfNextNextNext.[d1].Resize(UBound(res), 1) = WorksheetFunction.Transpose(res)End WithDebug.Print "组合完成,累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

3种实现方法生成结果、对比、耗时

图中C列中的数量为1-50范围内的随机数,D列即为结果
分别对3种方法生成结果进行统计、对比:
方法1、2生成结果完全相同,数量分布不集中;方法3最终装箱的箱数也更少,且数量集中在50,但剩余行数多
400行数据测试,方法1、2剩余4行,方法3剩余15行
在这里插入图片描述
3种方法代码运行速度,分别测试300行、400行数据的耗时秒数
方法3对比方法2需要多生成、遍历一遍组合,由于组合数成指数递增,因此其400行相比300行耗时大幅增加,且电脑内存最高占用6G。如果要使用方法3且数据量较大,最好还是分段运行代码,避免耗时过久
在这里插入图片描述

装箱结果整理

编号无序

字典以箱号为键,值为数组

Sub 装箱结果输出1无序()Dim arr, dict As Object, i&, j&, r&, c&, max_c&, rng As Range, xh, dw, slSet dict = CreateObject("scripting.dictionary"): tm = TimerWith Worksheets("数据")  '读取数据arr = .[a1].CurrentRegion: ReDim res(1 To UBound(arr) * 2, 1 To 10)res(1, 1) = "箱号": r = 0: Set rng = .Cells(1, 1).Resize(1, 3)  '表头For i = 2 To UBound(arr)If Len(arr(i, 4)) Thenxh = arr(i, 4): dw = arr(i, 2): sl = arr(i, 3)If Not dict.Exists(xh) Thenr = r + 2: dict(xh) = Array(r, 2, sl)  '箱号对应的行列号,数量合计res(dict(xh)(0), 1) = xh    '箱号、单位号、数量赋值res(dict(xh)(0), dict(xh)(1)) = dwres(dict(xh)(0) + 1, dict(xh)(1)) = slElsec = dict(xh)(1) + 1: hj = dict(xh)(2) + sl  '数量合计dict(xh) = Array(dict(xh)(0), c, hj)res(dict(xh)(0), dict(xh)(1)) = dw  '单位号、数量赋值res(dict(xh)(0) + 1, dict(xh)(1)) = slmax_c = WorksheetFunction.Max(max_c, c)  '最大列数End IfElseSet rng = Union(rng, .Cells(i, 1).Resize(1, 3))End IfNextEnd WithWith Worksheets("结果")  '写入结果r = r + 1: max_c = max_c + 1: res(1, max_c) = "总件数"For i = 2 To rIf Len(res(i, 1)) = 0 Thenres(i, 1) = "数量": res(i, max_c) = dict(res(i - 1, 1))(2)End IfNextFor j = 2 To max_c - 1res(1, j) = "单位号" & (j - 1)Next.[a1].Resize(r, max_c) = resIf Not rng Is Nothing Then rng.Copy .Cells(1, max_c + 2)  '无法装箱End WithDebug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

生成结果:对方法2生成数据(即本文图1)进行整理
在这里插入图片描述

编号有序

字典嵌套字典,代码速度较无序版稍慢
为保证编号有序,以下代码使用了一维数组排序,调用了bubble_sort函数,代码详见《Excel·VBA数组冒泡排序函数》(如需使用代码需复制)

Sub 装箱结果输出2有序()Dim arr, dict As Object, i&, j&, r&, c&, max_c&, rng As Range, xh, dw, slSet dict = CreateObject("scripting.dictionary"): tm = TimerWith Worksheets("数据")  '读取数据arr = .[a1].CurrentRegion: ReDim res(1 To UBound(arr) * 2, 1 To 10)res(1, 1) = "箱号": r = 0: Set rng = .Cells(1, 1).Resize(1, 3)  '表头For i = 2 To UBound(arr)If Len(arr(i, 4)) Thenxh = arr(i, 4): dw = arr(i, 2): sl = arr(i, 3)If Not dict.Exists(xh) ThenSet dict(xh) = CreateObject("scripting.dictionary")End Ifdict(xh)(dw) = dict(xh)(dw) + slElseSet rng = Union(rng, .Cells(i, 1).Resize(1, 3))End IfNextkrr = bubble_sort(dict.keys)  '有序箱号For Each k In krrr = r + 2: c = 1: res(r, c) = kFor Each kk In dict(k).keysc = c + 1: res(r, c) = kk: res(r + 1, c) = dict(k)(kk)Nextmax_c = WorksheetFunction.Max(max_c, c)  '最大列数NextEnd WithWith Worksheets("结果")  '写入结果r = r + 1: max_c = max_c + 1: res(1, max_c) = "总件数"For i = 2 To rIf Len(res(i, 1)) = 0 Thenres(i, 1) = "数量"res(i, max_c) = WorksheetFunction.sum(dict(res(i - 1, 1)).items)End IfNextFor j = 2 To max_c - 1res(1, j) = "单位号" & (j - 1)Next.[a1].Resize(r, max_c) = resIf Not rng Is Nothing Then rng.Copy .Cells(1, max_c + 2)  '无法装箱End WithDebug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub

生成结果:对方法2生成数据(即本文图1)进行整理
在这里插入图片描述
附件:《Excel·VBA定量装箱、凑数值金额、组合求和问题(附件)》

扩展阅读:《excelhome-一个装箱难题》

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.mzph.cn/news/23638.shtml

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

视频汇聚平台EasyCVR视频广场侧边栏支持拖拽

为了提升用户体验以及让平台的操作更加符合用户使用习惯&#xff0c;我们在EasyCVR v3.3版本中&#xff0c;支持面包屑侧边栏的广场视频、分组列表、收藏这三个模块拖拽排序&#xff0c;并且该操作在视频广场、视频调阅、电子地图、录像回放等页面均能支持。 TSINGSEE青犀视频…

Docker 容器化学习

文章目录 前言Docker架构 1、 docker安装2、启动docker服务3、设置docker随机器一起启动4、docker体验5、docker常规命令5.1、容器操作docker [run|start|stop|restart|kill|rm|pause|unpause]docker [ps|inspect|exec|logs|export|import] 5.2、镜像操作docker images|rmi|tag…

前端页面--视觉差效果

代码 <!DOCTYPE html> <html lang"en"> <head><meta charset"UTF-8"><meta name"viewport" content"widthdevice-width, initial-scale1.0"><link rel"stylesheet" href"https://un…

docker制作镜像

docker制作镜像 docker制作镜像有两种&#xff1a; 1.docker build dockerfile 2.基于容器制作镜像 基于容器制作镜像 语法&#xff1a;docker commit options 容器名称 参数&#xff1a; -a&#xff1a;作者 -c&#xff1a;修改dockfile创建的镜像 -m&#xff1a;提交…

宝存科技企业级固态硬盘解决方案助力企业应用性能提升

企业级固态硬盘解决方案的核心 企业级固态硬盘市场具有产品附加值高、同时进入门槛高的特征&#xff0c;由于国内外巨头和初创企业竞争依然激烈。想要在竞争中脱颖而出&#xff0c;根本还是要靠产品本身的品质和厂商实力。 企业级固态硬盘适用于各类企业应用场景 企业级固态硬盘…

三层交换实验

前言 在实际的企业应用中&#xff0c;我们会先建立不同的vlan把用户先隔开来。然后再通过三次交换机技术打通vlan直接的网络。 这样的目的如下&#xff1a; 隔离&#xff1a; 隔离是广播域&#xff0c;也就是隔离的是故障连通&#xff1a; 连通的是正常的通信 比如校园网&am…

leetcode 416. 分割等和子集

给你一个 只包含正整数 的 非空 数组 nums 。请你判断是否可以将这个数组分割成两个子集&#xff0c;使得两个子集的元素和相等。 示例 1&#xff1a; 输入&#xff1a;nums [1,5,11,5] 输出&#xff1a;true 解释&#xff1a;数组可以分割成 [1, 5, 5] 和 [11] 。 示例 2&a…

⛳ StringBuffer and StringBuilder 处理字符串

目录 ⛳ StringBuffer and StringBuilder 处理字符串&#x1f3a8; 一&#xff0c;简介&#x1f3ed; 二&#xff0c;常用方法&#x1f69c; 三 &#xff0c;StringBugger&#x1f43e; 四&#xff0c;StringBuilder⭐ 五&#xff0c;StringBuffer和StringBuilder面试 ⛳ Strin…

2023牛客暑期多校训练营6 A-Tree (kruskal重构树))

文章目录 题目大意题解参考代码 题目大意 ( 0 ≤ a i ≤ 1 ) , ( 1 ≤ c o s t i ≤ 1 0 9 ) (0\leq a_i\leq 1),(1 \leq cost_i\leq 10^9) (0≤ai​≤1),(1≤costi​≤109) 题解 提供一种新的算法&#xff0c;kruskal重构树。 该算法重新构树&#xff0c;按边权排序每一条边…

分布式异步任务处理组件(七)

分布式异步任务处理组件底层网络通信模型的设计--如图&#xff1a; 使用Java原生NIO来实现TCP通信模型普通节点维护一个网络IO线程&#xff0c;负责和主节点的网络数据通信连接--这里的网络数据是指组件通信协议之下的直接面对字节流的数据读写&#xff0c;上层会有另一个线程负…

PoseiSwap:基于 Nautilus Chain ,构建全新价值体系

在 DeFi Summer 后&#xff0c;以太坊自身的弊端不断凸显&#xff0c;而以 Layer2 的方式为其扩容成为了行业很长一段时间的叙事方向之一。虽然以太坊已经顺利的从 PoW 的 1.0 迈向了 PoS 的 2.0 时代&#xff0c;但以太坊创始人 Vitalik Buterin 表示&#xff0c; Layer2 未来…

iOS-砸壳篇(两种砸壳方式)

CrackerXI砸壳呢&#xff0c;当时你要是使用 frida-ios-dump 也是可以的&#xff1b; https://github.com/AloneMonkey/frida-ios-dump frida-ios-dump: 代码中需要更改的&#xff1a;手机中的内网ip 密码 等 最后放到我的砸壳路径里&#xff1a; python dump.py -l查看应用…

SpringBoot自定义注解 + AOP+分布式Redis 防止重复提交

第一步 引入依赖pom.xml&#xff1a; <dependency><groupId>org.redisson</groupId><artifactId>redisson</artifactId><version>3.16.3</version> <!-- 使用最新版本 --></dependency><dependency><groupId&g…

单片机传感器类型一览

一、单片机&#xff1a; c51、attiny85 < arduino、stm8/stm32 < esp8266、esp32、raspiberry pico 功能简单型&#xff1a;C51、Attiny85等 功能可以较复杂型&#xff1a;Arduino < STM32 联网、人工智能等高级复杂型&#xff1a;esp8266 < esp32、pico …

docker-compose

文章目录 一、docker-compose简介二、docker-compose安装1.安装命令2.卸载旧版本3.修改权限4、常用命令 总结 一、docker-compose简介 示例&#xff1a;pandas 是基于NumPy 的一种工具&#xff0c;该工具是为了解决数据分析任务而创建的。 二、docker-compose安装 1.安装命令…

JMeter 4.x 简单使用

文章目录 前言JMeter 4.x 简单使用1. 启动2. 设置成中文3. 接口测试3.1. 设置线程组3.2. HTTP信息请求头管理器3.3. 添加HTTP请求默认值3.4. 添加HTTP cookie 管理3.5. 添加http请求3.5.1. 添加断言 3.6. 添加监听器-查看结果树3.7. 添加监听器-聚合报告 4. 测试 前言 如果您觉…

打开的idea项目maven不生效

方法一&#xff1a;CtrlshiftA&#xff08;或者help---->find action&#xff09;&#xff0c; 输入maven&#xff0c; 点击add maven projects&#xff0c;选择本项目中的pom.xml配置文件&#xff0c;等待加载........ 方法二&#xff1a;view->tools windows->mave…

【RabbitMQ(day4)】SpringBoot整合RabbitMQ与MQ应用场景说明

一、SpringBoot 中使用 RabbitMQ 导入对应的依赖 <dependency><groupId>org.springframework.boot</groupId><artifactId>spring-boot-starter-amqp</artifactId></dependency>配置配置文件 spring:application:name: rabbitmq-springbo…

CSS3标题文本后的横线

示例代码 <template><div><h2 class"background">删除线</h2><h2 class"background"><span>左右两侧线</span></h2><h2 class"background double"><span>双层线</span></…

Python 扩展 快捷贴士:os模块下的创建目录的方式

Python3 os.makedirs() 方法 概述 os.makedirs() 方法用于递归创建多层目录。 如果子目录创建失败或者已经存在&#xff0c;会抛出一个 OSError 的异常&#xff0c;Windows上Error 183 即为目录已经存在的异常错误。 如果第一个参数 path 只有一级&#xff0c;即只创建一层目…