甘肃肃第八建设集团网站1,广西玉林建设厅官方网站,网站设计旅行社新闻内容,济宁华园建设有限公司网站如图#xff1a;对图中A-C列数据#xff0c;根据C列数量按照一定的取值范围#xff0c;组成一个分组装箱#xff0c;要求如下#xff1a; 1#xff0c;每箱数量最好凑足50#xff0c;否则为47-56之间#xff1b; 2#xff0c;图中每行数据不得拆分#xff1b; 3… 如图对图中A-C列数据根据C列数量按照一定的取值范围组成一个分组装箱要求如下 1每箱数量最好凑足50否则为47-56之间 2图中每行数据不得拆分 3按顺序对分组装箱结果进行编号如D列中BS0001 4生成分组装箱结果包含B-C列数据以及单独生成最终无法装箱的数据 目录 实现方法1实现方法2实现方法33种实现方法生成结果、对比、耗时 装箱结果整理编号无序编号有序 本问题本质上是组合求和问题调用了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, ctarget 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, ctarget 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, ctarget 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 Sub3种实现方法生成结果、对比、耗时
图中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-一个装箱难题》
