基于BOM结构的分级数据对比匹配，累加求和

lele400024

此BOM结构是针对工程进度款支付数据，纵向分专业（会有很多专业，专业是第一级）按楼栋逐级划分；各楼栋下细分各类别及下级各项清单；
横向主要分三大类，从左至右分别为，①截止上月末累计完成，②本月完成，③截止本月末累计完成；






实现目的：
1、将②本月源数据与①上月源数据工作表根据BOM不同层级进行匹配后（项目名称【精确匹配】及审核单价【精确匹配】为关键字段）
上月源数据

①上月源数据

本月源数据

实现功能

（1）若②本月源数据项目名称与①上月源数据工作表中一致，但审核单价不一致，则不属于同项清单，则在“实现功能”工作表中“项目名称”列中对应专业及对应楼栋中“类别1”下级增加一项清单；

（2）若一致将BOM结构分专业-分楼栋-分类别级别下各清单，分别填写在“实现功能”工作表中列区域①、②对应的列中，③数据=①+②（以项为单位的工程量不求和，仅合计金额求和）
难点在需根据两个字段精确匹配，若不匹配，需插入行增加数据




2、将BOM结构各层级分类汇总
可借鉴 yjh_27老师在该帖子的应用   https://club.excelhome.net/thread-1283027-1-1.html  
附件中根据老师代码，调整修改了一部分，还需完善。




3、再单独新建一个汇总表，分专业将各楼栋数据汇总到该表格中


基于BOM结构的分级数据对比匹配及累加求和.rar (171.31 KB, 下载次数: 21)

2022-4-22 23:44 上传

点击文件名下载附件

感谢各位老师看完帖子，因为每个月工作涉及两个工作簿上万条数据匹配，要花很长时间才能一一对应后汇总，希望能找到更好的方法，谢谢大家。

microyip

这个是大工程啊，估计很多人等着这生意

lele400024

本月累计完成金额，到下个月又变成了上月累计完成金额

小小拖鞋

同是造价人

笨鸟飞不高

这个贴子看过了，正如2楼老师说的，这是个大工程，象我这种业务爱好者就不参与了！！

lele400024

笨鸟飞不高 发表于 2022-4-23 14:55
这个贴子看过了，正如2楼老师说的，这是个大工程，象我这种业务爱好者就不参与了！！

好的，还是感谢老师查看

lele400024

1. Sub aaa1()   '自定义函数将不同清单放在末尾，不能实现放在对应楼栋下面
   
2. Dim cc, brr, crr
   
3. t = Timer
   
4. Sheets("实现功能2").Range("c5").Resize(10000, 20).ClearContents
   
5. 
   
6. r1 = Sheets("截止上月源数据").Range("c" & Rows.Count).End(xlUp).Row
   
7. r2 = Sheets("本月源数据").Range("c" & Rows.Count).End(xlUp).Row
   
8. brr = Sheets("截止上月源数据").Range("c2:i" & r1)
   
9. crr = Sheets("本月源数据").Range("c2:i" & r2)
   
10. 
    
11. 
    
12. drr = Arraymerge("5,,,,1;2;3;4,", brr, crr)
    
13. r3 = Sheets("实现功能2").Range("c" & Rows.Count).End(xlUp).Row + 1
    
14. 
    
15. Sheets("实现功能2").Range("c" & r3 + 1).Resize(UBound(drr), UBound(drr, 2)) = drr
    
16. 
    
17. 
    
18. MsgBox Timer - t
    
19. End Sub

复制代码

仅能实现部分还请各位老师不吝赐教


基于BOM结构的分级数据对比匹配及累加求和-初稿.rar (194.81 KB, 下载次数: 4)

2022-4-26 03:24 上传

点击文件名下载附件

修改调整代码后，不知道什么问题，老是出现错误
调整后的代码如下

1. Sub aaa2()   '代码不知哪里问题
   
2. Dim cc, brr(), crr()
   
3. t = Timer
   
4. Sheets("实现功能2").Range("c5").Resize(10000, 20).ClearContents
   
5. 
   
6. r1 = Sheets("截止上月源数据").Range("c" & Rows.Count).End(xlUp).Row
   
7. r2 = Sheets("本月源数据").Range("c" & Rows.Count).End(xlUp).Row
   
8. arr = Sheets("截止上月源数据").Range("c2:i" & r1)
   
9. crr2 = Sheets("本月源数据").Range("c2:i" & r2)
   
10. 
    
11. m = 0
    
12. ReDim arr2(1 To 19)
    
13. For i = 1 To r1
    
14. On Error Resume Next
    
15.     If Right(arr(i, 1), 1) = "栋" And arr(i, 1) <> "" Then
    
16.         m = m + 1
    
17.         
    
18.         arr2(m) = Left(arr(i, 1), 4)
    
19.     End If
    
20. Next i
    
21. 
    
22. 
    
23. For j = 1 To UBound(arr2)
    
24. n = 0: n2 = 0
    
25.     For i = 1 To r1
    
26.         If Left(arr(i, 1), 4) = arr2(j) Then
    
27.             n = n + 1
    
28.             ReDim Preserve brr(n, 7)
    
29.             For ii = 0 To UBound(arr, 2)
    
30.                 brr(n, ii) = arr(i, ii)
    
31.             Next
    
32.         End If
    
33.     Next
    
34.    
    
35.     For g = 1 To r2
    
36.         If Left(crr2(g, 1), 4) = arr2(j) Then
    
37.             n2 = n2 + 1
    
38.             ReDim Preserve crr(n2, 7)
    
39.             For gg = 0 To UBound(crr2, 2)
    
40.                 crr(n2, gg) = crr2(g, gg)
    
41.             Next
    
42.         End If
    
43.     Next
    
44. 
    
45.     drr = Arraymerge("5,,,,1;2;3;4,", brr, crr)
    
46.    
    
47.     r3 = Sheets("实现功能2").Range("c" & Rows.Count).End(xlUp).Row + 1
    
48. 
    
49.     Sheets("实现功能2").Range("c" & r3 + 1).Resize(UBound(drr), UBound(drr, 2)) = drr
    
50.     Erase drr
    
51. Next
    
52.         
    
53. 
    
54. 
    
55. 
    
56. MsgBox Timer - t
    
57. End Sub

复制代码