前言:
本篇是建筑幕墙零部件计算器(Excel版)的使用说明书。
零部件计算与查询器为建筑幕墙设计专用程序,适用于有查询及算料需求的幕墙设计或工厂算料人员使用。(程序亦适用于迭代递归的材料计算)
程序的主要功能有:
1,查询单元体,组装件,零部件,玻璃的各项参数(如描述尺寸等),并标识错误数据。
2,根据单元体或者组装件的数量,快速计算其零部件的数量。
3,根据零部件编号,反向查询其应用位置,快速知晓零部件所影响的范围。
4,根据单元体,组装件,零部件,玻璃的编号数量,进行查询并分类汇总排序。
5,特殊用法,编号数量的分类汇总(无论编号是否在数据库中,均可分类汇总)
6,有数据库的,可快速链接数据库各项数据,方便使用数据。
版本适用:Excel版是用Office2016版开发的,理论上Office2010以上版本都可以使用,WPS未测试(使用结果未知)。
性能说明:根据程序设计,正向计算比反向查询耗时更少,反向模糊查询最慢。对计算影响最大的是,Assy表格数据量,其数据条数越大,编号嵌套级数越多,计算速度越慢。
普通情况下,数据库数据在几千条时,无论正向计算反向查询还是模糊查询,均只需要不到0.5秒即可计算完成(如果有0.1秒以下计算完成的,敬请留言)。
经极限测试,数据量总条数在7万时(Assy:5.1万条,Part:1.8万条,Glass:900条),程序仍可良好运行,正向计算时间在2秒完成,少量反向查询也只耗时2秒完成,大量的反向查询耗时会更多。而模糊查询由于匹配的编号数量不确定,耗时情况不确定,大致需要60秒完成。由于手头没有更大数据库,无法做更大测试。当然一般而言,反向查询多为单个编号查询。如果有更大数据库的,欢迎测试后留言。
(PS:反向查询及模糊查询性能考虑在在下一版程序中,进一步更新算法,加强其性能,使之与正向计算性能相当。作者业余更新,近期有其他安排,可能会拖更到元旦前后。)
本篇使用说明书,分三个方面介绍:
一,使用说明;
二,代码原理与设计说明;
三,源代码分享。
自述:一般来说直接使用Access制作数据计算与查询比用Excel更便捷简单,但是一般就办公环境而言,大多数人可能都没有安装Access,因此Excel的试用性反而更广,操作起来更为熟悉便利。另外建筑幕墙零部件数据量通常只有几万条,甚至少的话,只有几千条。秉承越简单越便捷,因此用Excel处理几万条数据性能已经足够了。之前发布(CMD版)时,Excel版的计算功能其实早已制作完成,但是我个人不太满意,于是又大改了一番,并加入了零部件反向查询功能,另外对几种特殊使用情况产生的Bug进行了修复。总体上此版本已经比较完善。一般情况下计算都是秒出,当然这个跟数据库的大小以及每个人的计算机有关,我的是笔记本,计算速度算是偏下。(程序下载链接获取方式在文章结尾处)
以下是计算器界面截图:
以下是视频使用说明:(视频横屏,有些模糊,建议放大到全屏播放)
为赶路人干杯.
文字版使用说明
一,使用说明
(1)文件介绍及前期准备
压缩包打开后的两个文件 (附件数据库,只是示意文件,下载试用后请删除!)
零部件计算器本身是在PisaAccess数据库基础上开发的,没有数据库的话会不太方便,当然也可以修改代码,适配不同的数据格式。
首次打开,启用数据链接。
(1.1) 有数据库的
将原数据库替换成自己的数据库文件,然后点击“更新数据源”按钮。
特别说明:更新数据源,只是将数据库中的数据复制到表格中,不会对数据库造成影响。
(1.2) 没有数据库文件的
需要填写 Assy,Part,Glass三个工作表,填写后的数据表,一定要用其他表格备份或者将表格另外导出,以免程序错误或者失效导致原始数据丢失!!!切记备份!
工作表 Assy
工作表 Part
工作表 Glass
(工作表Glass,可以不填数据,但请保留表头,以利程序运行。)
(2) 计算说明
(2.1) 正向计算
正向计算说明:
“正向计算”选项,是指用根据单元体或组件编号数量,计算所需的零部件编号和数量。
“玻璃”选项:勾选则计算结果包含玻璃,反之不含。
“描述”选项:勾选则计算结果包含描述,反之不含。
“DimA”选项:勾选则计算结果包含DimA,反之不含。
“DimB”选项:勾选则计算结果包含DimA,反之不含。
填入待计算单元体或者组装件,然后点击“零部件计算”即可。(详情可查看视频)
(2.2) 反向查询
反向查询说明:
“反向查询”选项,是指用零部件查询:单元体或组装件中的零部件使用情况。
查询关系为:零部件--查--组件,组件--查--单元体,层层递进,直到查询到最后一层。
“反向查询”默认为精确查询,勾选“模糊”选项为模糊查询。
“模糊”查询如果编号有多项,且存在正确与错误的编号,错误编号将不会在结果中显示。
“反向查询”的结果:
“第0级”时:“数量”为零部件的汇总数量,“描述”及“尺寸”均属零部件。
“第1级”时:“数量”为零部件在单元体或组装件中的数量,“描述”及“尺寸”均属单元体或组装件。
“第2级”时:“数量”为组装件在单元体中数量,“描述”及“尺寸”均属单元体。以此类推。
填入待查询的零件或者组装件,然后点击“零部件计算”即可。(详情可查看视频)
反向查询,不需要数量,如果有多个编号且存在数量,同样会被分类去重汇总
(3) 其他特殊用法
反向查询中的模糊查询以及其他特殊用法,请查看视频。
二,代码原理与设计说明
Excel版是用Office2016版开发了,理论上Office2010以上版本都可以 使用,WPS未测试(使用结果未知)。
程序运行流程示意(正向计算)(没有找到好的工具绘制,流程大致如此)
基本原理是使用VBA数组与字典,然后循环判断出相应的零部件编号,在对编号进行相应的累加汇总,最后排序。反向计算原理也是类似的,只是反向索引而已。因为是遍历整个数据表,因此原始数据越大,电脑运行速度越慢,计算速度也就越慢。
整个过程编程并不复杂,最为麻烦的是特殊使用场景下的BUG.
例如以下情况的处理,计算表中含空格,需要要标识出来,数量列有的填了数量,有的填错了,有的在正向计算中没有问题,但是在反向查询中或者模糊反向查询中又有问题,还有就是如果数据源中没有相关编号或者数据源存在问题,这些就是程序中需要修正的BUG. 另外程序在不同选项中的逻辑怎么安排,相关代码顺序一调换,结果完全不同。
三,原代码分享(正向计算源代码)
源代码几经精简,删除注释和空格后,仍然有六百多条。实在太多了,所以就放个关键正向计算代码,另外代码需要设置相关按钮,直接复制是无法使用的,有兴趣的同学可自行研究,并找出明显的BUG。
'正向计算
Sub Forward()
'声明数组
Dim Assy, Part, Glass, List, Count,
Assy = Sheet1.Range("A1").CurrentRegion.Value
Part = Sheet2.Range("A1").CurrentRegion.Value
Glass = Sheet3.Range("A1").CurrentRegion.Value
List = Sheet4.Range("A1", Range("A1048576").End(xlUp).Offset(0, 1)).Value
'声明字典及循环参数
Dim Dic As Object, Key$, D_key, D_item, n&, i&, j&, k&, Rng As Range,
Set Dic = CreateObject("Scripting.Dictionary")
k = 0
'第0级,去空行,去重汇总
For i = 2 To UBound(List, 1) Step 1
Key = List(i, 1)
If Dic.exists(Key) Then
Dic.Item(Key) = Dic.Item(Key) + List(i, 2)
Else
Dic.Add Key, List(i, 2)
End If
Next
n = Dic.Count
D_key = Dic.Keys
D_item = Dic.Items
ReDim Count(1 To n, 1 To 6)
'录入数组
For i = 1 To n Step 1
For j = 2 To UBound(Part, 1) Step 1
If D_key(i - 1) = Part(j, 1) Then
Count(i, 1) = Part(j, 1)
Count(i, 2) = Part(j, 2)
Count(i, 3) = Part(j, 3)
Count(i, 4) = Part(j, 4)
Count(i, 5) = D_item(i - 1)
Count(i, 6) = "第 " & k & " 级"
End If
Next
Next
'判断是否录入玻璃
If Sheet4.CheckBox1.Value = True Then
For i = 1 To n Step 1
For j = 2 To UBound(Glass, 1) Step 1
If Count(i, 1) = Glass(j, 1) Then
Count(i, 2) = Glass(j, 2)
Count(i, 3) = Glass(j, 3)
Count(i, 4) = Glass(j, 4)
End If
Next
Next
Else
For i = 1 To n Step 1
For j = 2 To UBound(Glass, 1) Step 1
If Count(i, 1) = Glass(j, 1) Then
Count(i, 1) = ""
Count(i, 2) = ""
Count(i, 3) = ""
Count(i, 4) = ""
Count(i, 5) = ""
Count(i, 6) = ""
End If
Next
Next
End If
'检查原始数据是否存在异常
For i = 1 To n Step 1
If D_key(i - 1) <> "" And D_key(i - 1) <> Count(i, 1) Then
Count(i, 1) = D_key(i - 1)
Count(i, 2) = "警告!此编号无数据源,请检查!并添加数据源!"
Count(i, 3) = "无数据源!"
Count(i, 4) = "无数据源!"
Count(i, 5) = D_item(i - 1)
Count(i, 6) = "第 " & k & " 级"
ElseIf D_key(i - 1) = "" Then
Count(i, 1) = "`Nothing"
Count(i, 2) = "警告!计算区域存在空行!(注:空行不影响计算结果)"
Count(i, 3) = "存在空行!"
Count(i, 4) = "存在空行!"
Count(i, 5) = ""
Count(i, 6) = "第 " & k & " 级"
End If
Next
'录入表格
Set Rng = Sheet4.Range("G1048576").End(xlUp).Offset(1, 0).Resize(n, 6)
Rng = Count
Rng.Sort Rng.Cells(1, 1), xlAscending, Header:=xlNo
'第N级,去重汇总
Loopp:
k = k + 1
Erase Count
Dic.RemoveAll
For i = 1 To UBound(D_key) + 1 Step 1
For j = 2 To UBound(Assy, 1) Step 1
If D_key(i - 1) = Assy(j, 1) Then
Key = Assy(j, 2)
If Dic.exists(Key) Then
Dic.Item(Key) = Dic.Item(Key) + D_item(i - 1) * Assy(j, 3)
Else
Dic.Add Key, D_item(i - 1) * Assy(j, 3)
End If
End If
Next
Next
If n > 0 Then
D_key = Dic.Keys
D_item = Dic.Items
ReDim Count(1 To n, 1 To 6)
Else
GoTo Endd
End If
For i = 1 To n Step 1
For j = 2 To UBound(Part, 1) Step 1
If D_key(i - 1) = Part(j, 1) Then
Count(i, 1) = Part(j, 1)
Count(i, 2) = Part(j, 2)
Count(i, 3) = Part(j, 3)
Count(i, 4) = Part(j, 4)
Count(i, 5) = D_item(i - 1)
Count(i, 6) = "第 " & k & " 级"
End If
Next
Next
If Sheet4.CheckBox1.Value = True Then
For i = 1 To n Step 1
For j = 2 To UBound(Glass, 1) Step 1
If Count(i, 1) = Glass(j, 1) Then
Count(i, 2) = Glass(j, 2)
Count(i, 3) = Glass(j, 3)
Count(i, 4) = Glass(j, 4)
End If
Next
Next
Else
For i = 1 To n Step 1
For j = 2 To UBound(Glass, 1) Step 1
If Count(i, 1) = Glass(j, 1) Then
Count(i, 1) = ""
Count(i, 2) = ""
Count(i, 3) = ""
Count(i, 4) = ""
Count(i, 5) = ""
Count(i, 6) = ""
End If
Next
Next
End If
For i = 1 To n Step 1
If D_key(i - 1) <> Count(i, 1) Then
Count(i, 1) = D_key(i - 1)
Count(i, 2) = "警告!此编号无数据源,请检查!并添加数据源!"
Count(i, 3) = "无数据源!"
Count(i, 4) = "无数据源!"
Count(i, 5) = D_item(i - 1)
Count(i, 6) = "第 " & k & " 级"
End If
Next
Set Rng = Sheet4.Range("G1048576").End(xlUp).Offset(2, 0).Resize(n, 6)
Rng = Count
Rng.Sort Rng.Cells(1, 1), xlAscending, Header:=xlNo
GoTo Loopp
Endd:
Erase Assy
Erase Part
Erase Glass
Erase List
Dim Warn
Warn = Sheet4.Range("H1", Sheet4.Range("H1048576").End(xlUp))
For i = 1 To UBound(Warn) Step 1
If Warn(i, 1) Like "警告*" = True Then
Sheet4.Range("G" & i, "L" & i).Interior.Color = 65535
If Sheet4.CheckBox2.Value = False And Sheet4.CheckBox3.Value = False And Sheet4.CheckBox4.Value = False Then
Sheet4.Range("G" & i).AddComment text:="警告!" & Chr(10) & "此编号无数据源!"
Sheet4.Range("G" & i).Comment.Visible = False
End If
End If
Next
Erase Warn
If Sheet4.CheckBox4.Value = False Then
Sheet4.Columns("J:J").Delete
End If
If Sheet4.CheckBox3.Value = False Then
Sheet4.Columns("I:I").Delete
End If
If Sheet4.CheckBox2.Value = False Then
Sheet4.Columns("H:H").Delete
End If
End Sub
结尾
以下为程序下载链接获取方式:
公众号:为赶路人干杯
回复:零部件计算器
(文件下载后有可能会被电脑安全软件查杀,需要选择信任,并启用宏。)
请试用程序过后,麻烦大家投个票,做一个程序欢迎度调查,以便进一步改进程序。(初版程序难免有些Bug,投票留言赞赏将优先试用下一版更新程序)(另外作者想对程序欢迎度及使用次数进行简单统计,而程序本身不联网,因此加入了几个简单的验证码用于程序测试。请知悉!)
(最后要补充的是,分享程序时,请尽量 直接转发文章 或者使用 公众号回复的获取下载链接 分享,以保证原始程序的一致性,以免出错。直接转发下载好的程序,有可能会导致程序出错,无法使用,敬请留意。此版程序免费,考虑到使用体验,未进行.dll加密处理,有兴趣的自行研究,但严禁盗用程序进行商业倒卖。)
如发现有使用问题,请在本篇说明下面留言,或者公众号留言。
如果觉得程序有用,请一键三连,在看点赞收藏,并转发给有需要的人,希望程序能帮助到更多的设计人员。
此程序为专业幕墙设计的业余程序作品,原创编辑不易,我手写我心,你赏表你心。
最后的最后,希望程序对您所帮助。