Excel Vba批处理在建筑工程资料的运用思路

念头不通达

已于 2022-05-25 09:38:13 修改

阅读量556

点赞数 2

分类专栏： VBA Excel 文章标签：经验分享源码软件职场和发展

于 2022-05-24 20:33:02 首次发布

本文链接：https://blog.csdn.net/weixin_61071373/article/details/124952122

版权

VBA 同时被 2 个专栏收录

2 篇文章 0 订阅

订阅专栏

Excel

2 篇文章 0 订阅

订阅专栏

前言：

从事工程行业的伙伴，可能都有为资料加班的头疼经历。每天去现场跑不说，回来还要加班赶资料。工程资料体系庞大、逻辑严密、前后相关，一处出错可能就要打回重新编制，消耗大量宝贵的时间和精力，让人念头不能通达。工程资料的编制是根据图纸和规范分部位填写各种实测数据，还要考虑典型部位的特殊情况、注意前后照应，不能有矛盾。

工作不仅为公司带来价值，还要能提高自身的职业能力与职业素养。这种数据的编制无异于又做回了新一代的螺丝工，怎么让我们的工作更快速、高质、批量地完成，从易错的重复劳动中解放出来，用节省下来的时间提高专业技能，是我在从事这类重复量高的工作时经常思考的问题。奈何能力有限，编不出什么专业的资料软件，就当前条件和学习成本，还是Excel Vba更合适。市面上也有很多资料软件，鉴于各地方、部门、管理方法的不同，这些软件收费不说，而且很可能达不到我们的现实需求，并不能从根本上解决问题。求人不如求己，学会运用一种工具，只要能解决一类问题，研究通了工作思路，其他的类似问题都能水到渠成。

能点进来的伙伴一般都对Excel Vba有所了解，它一般是用来实现简单或中等的办公自动化应用。下文就是结合博主在工程建设行业的一些编制资料的经验，分享的Excel vba在建筑工程资料的运用思路。

（一）熟悉通用规范表格

之所以在网上很难找到适合自己的一套资料编制模板，就是因为行业跨度大、范围广、地方标准的不统一，还有业主、监理的管理方式的不同和项目的特殊性，想要做一套适合自己的编写模板，更多的需要自己研究发掘，思路只能是引导性的，具有通用性，自己适用的还需要在工作中发现、提炼规律才能完美运用。

（二）研究图纸文件和归档要求

本文就以交安标志资料为例。首先要了解交通标志的图纸文件，把该工程的分布分项、标志的设置桩号进行划分，编号，然后将标志检测项目的的详细规格、尺寸、部位、字体高度、反射系数、净空高度、竖直度等参数的标准值和规范要求的允许偏差值的上限和下限做好统计，分类编排，作为数据库。

（三）调试和打印

基础数据库建立后，检查无误，就可以在模板上填好单位名称，调好页面和纸张，进行PDF打印测试了。（由于编者时间有限，编写此功能的逻辑没有优化，算是个小bug吧，当时是每做完一次引用数据的循环之后会删除原引用的的数据行，用此方法把数据从第一行依次读取到最后一行，直至判断为空停止，所以在测试打印前要先做下文件备份。）

检验表：

评定表：

（四）代码运行思路分析

1.实现原理

在sheet2表上部分分别是《分项工程质量检验表》和《交通标志分项工程质量检验评定表》，这两个作为模板，然后在sheet2表最下方建立一个临时文档，方便引用sheet1的数据源和进行调试的立即窗口面板。《分项工程质量检验表》根据建立的数据引用源，规定的标准值和偏差值，会按预定的计算算法进行填写引用表的数据，《交通标志分项工程质量检验评定表》是对数据的二次加工，主要是填写实测数据与标准值的偏差值。

2.检验表代码

Option Explicit
Sub 检验表()
Dim rn As Range, a!, b!, c!, d!, e!, f!, g!, h!, m, n, o, p, q, r, k
Dim i As Integer
'标题栏
Sheet2.Range("E3") = Sheet1.Range("D3")
Sheet2.Range("E24") = Sheet1.Range("D3")
'01标志尺寸(mm)
a = Sheet1.Range("e3") + Sheet1.Range("g3")
b = Sheet1.Range("e3") + Sheet1.Range("h3")
c = Sheet1.Range("f3") + Sheet1.Range("g3")
d = Sheet1.Range("f3") + Sheet1.Range("h3")
For Each rn In Range("f7:g7")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("h7:i7")
rn.Value = CDbl(Int((c - d) * Rnd() * 100) / 100 + d)
rn.NumberFormatLocal = "0"
Next
'01标志尺寸(mm)标准值
a = Sheet1.Range("e3")
c = Sheet1.Range("f3")
For Each rn In Range("f55:g55")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("h55:i55")
rn.Value = c
rn.NumberFormatLocal = "0"
Next
'02字体高度
a = Sheet1.Range("i3") + Sheet1.Range("j3")
b = Sheet1.Range("i3") + Sheet1.Range("k3")
For Each rn In Range("f8:g8")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'02字体高度标准值
a = Sheet1.Range("i3")
For Each rn In Range("f56:g56")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'03-1逆反射系数01
For Each rn In Range("f9:o9")
rn.Value = "V级"
Next
'03-1逆反射系数01标准值
For Each rn In Range("f57:o57")
rn.Value = "V级"
Next
'03-2逆反射系数02绿色
a = Sheet1.Range("l3") + Sheet1.Range("m3")
b = Sheet1.Range("l3") + Sheet1.Range("n3")
For Each rn In Range("f10:o10")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'03-2逆反射系数02绿色标准值
a = Sheet1.Range("l3")
For Each rn In Range("f58:o58")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'03-3逆反射系数03白色
a = Sheet1.Range("o3") + Sheet1.Range("p3")
b = Sheet1.Range("o3") + Sheet1.Range("q3")
For Each rn In Range("f11:o11")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'03-3逆反射系数03白色标准值
a = Sheet1.Range("o3")
For Each rn In Range("f59:o59")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'04净空高度
a = Sheet1.Range("r3") + Sheet1.Range("s3")
b = Sheet1.Range("r3") + Sheet1.Range("t3")
For Each rn In Range("f12:o12")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'04净空高度标准值
a = Sheet1.Range("r3")
For Each rn In Range("f60:o60")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'05立柱竖直度
a = Sheet1.Range("u3") + Sheet1.Range("v3")
b = Sheet1.Range("u3") + Sheet1.Range("w3")
For Each rn In Range("f13:o13")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'05立柱竖直度标准值
a = Sheet1.Range("u3")
For Each rn In Range("f61:o61")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'06涂镀层厚度1
a = Sheet1.Range("x3") + Sheet1.Range("y3")
b = Sheet1.Range("x3") + Sheet1.Range("z3")
For Each rn In Range("f14:o14")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'06涂镀层厚度1标准值
a = Sheet1.Range("x3")
For Each rn In Range("f62:o62")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'06涂镀层厚度2
a = Sheet1.Range("aa3") + Sheet1.Range("ab3")
b = Sheet1.Range("aa3") + Sheet1.Range("ac3")
For Each rn In Range("f15:o15")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
'06涂镀层厚度2标准值
a = Sheet1.Range("aa3")
For Each rn In Range("f63:o63")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
'07基础尺寸
a = Sheet1.Range("ae3") + Sheet1.Range("ah3")
b = Sheet1.Range("ae3") + Sheet1.Range("ai3")
c = Sheet1.Range("af3") + Sheet1.Range("ah3")
d = Sheet1.Range("af3") + Sheet1.Range("ai3")
e = Sheet1.Range("ag3") + Sheet1.Range("ah3")
f = Sheet1.Range("ag3") + Sheet1.Range("ai3")
For Each rn In Range("f16:g16")
rn.Value = CDbl(Int((a - b) * Rnd() * 100) / 100 + b)
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("h16:i16")
rn.Value = CDbl(Int((c - d) * Rnd() * 100) / 100 + d)
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("j16:k16")
rn.Value = CDbl(Int((e - f) * Rnd() * 100) / 100 + f)
rn.NumberFormatLocal = "0"
Next
'07基础尺寸标准值
a = Sheet1.Range("ae3")
c = Sheet1.Range("af3")
e = Sheet1.Range("ag3")
For Each rn In Range("f64:g64")
rn.Value = a
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("h64:i64")
rn.Value = c
rn.NumberFormatLocal = "0"
Next
For Each rn In Range("j64:k64")
rn.Value = c
rn.NumberFormatLocal = "0"
Next
'08基础
Sheet2.Range("f17") = Sheet1.Range("aj3")
'08基础标准值
Sheet2.Range("f65") = 0
'09求检测结果
For m = 0 To 2 '第一区间
Range("f7").Select
i = 0
Do Until Range("f7").Offset(m, i) = ""
If i > 9 Then Exit Do
i = i + 1
Range("p7").Offset(m, 0) = i '09求检测点数
Range("p7").Offset(m, 1) = i '09求合格点数
Range("p7").Offset(m, 2) = 0 '09求不合格点数
Loop
Next
For m = 5 To 10 '第二区间
Range("f7").Select
i = 0
Do Until Range("f7").Offset(m, i) = ""
If i > 9 Then Exit Do
i = i + 1
Range("p7").Offset(m, 0) = i '09求检测点数
Range("p7").Offset(m, 1) = i '09求合格点数
Range("p7").Offset(m, 2) = 0 '09求不合格点数
Loop
Next
End Sub

3.评定表代码

Option Explicit
Sub 评定()
Dim rn As Range, a!, b!, c!, d!, e!, f!, g!, h!, m, n, o, p, q, r, k
Dim i As Integer
'给评定表赋值
For m = 0 To 0 '第一行标志尺寸填写
Range("f28").Select
i = 0
Do Until Range("f7").Offset(m, i) = ""
If i > 9 Then Exit Do
o = Range("f7").Offset(m, i)
p = Range("f55").Offset(m, i)
Range("f28").Offset(m, i) = o - p
i = i + 1
Loop
Next
For m = 0 To 0  '第二行字体高度填写
Range("f30").Select
i = 0
Do Until Range("f8").Offset(m, i) = ""
If i > 9 Then Exit Do
o = Range("f8").Offset(m, i)
p = Range("f56").Offset(m, i)
Range("f30").Offset(m, i) = o - p
i = i + 1
Loop
Next
For m = 0 To 0  '第三行反光膜等级填写
Range("f31").Select
i = 0
Do Until Range("f9").Offset(m, i) = ""
If i > 9 Then Exit Do
o = Range("f9").Offset(m, i)
p = Range("f56").Offset(m, i)
Range("f31").Offset(m, i) = o
i = i + 1
Loop
Next
For m = 0 To 7 '四到八行评定数值填写
Range("f32").Select
i = 0
Do Until Range("f10").Offset(m, i) = ""
If i > 9 Then Exit Do
o = Range("f10").Offset(m, i)
p = Range("f58").Offset(m, i)
Range("f32").Offset(m, i) = o - p
i = i + 1
Loop
Next
'质量评定结果
'求平均数
For i = 1 To 3
Range("p" & i + 27) = Application.Average(Range("f" & i + 27 & ": o" & i + 27))
Next
For i = 5 To 11
Range("p" & i + 27) = Application.Average(Range("f" & i + 27 & ": o" & i + 27))
Next
'合格率
For Each rn In Range("q28:q39")
rn.Value = 100
Next
'权值
For Each rn In Range("r28:r30")
rn.Value = 1
Next
Range("r31").Value = 2
For Each rn In Range("r34:r35")
rn.Value = 1
Next
Range("r36").Value = 2
For Each rn In Range("r38:r39")
rn.Value = 1
Next
'评定表实得分
For Each rn In Range("s28:s30")
rn.Value = 100
Next
Range("s31").Value = "200" & "%"
For Each rn In Range("s34:s35")
rn.Value = 100
Next
Range("s36").Value = 200
For Each rn In Range("s38:s39")
rn.Value = 100
Next
'数据区保留小数
Range("f28:p38").NumberFormatLocal = "0"
Range("f39").NumberFormatLocal = "0.0"
Range("a1").Select
End Sub

4.打印部分

Sub 打印部分()
Do Until Sheet1.Range("c3") = "" 
If k >= 2 Then Exit Do '打印

'''检验、评定内容

'打印循环
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
        k = i + 1 '计数
 Loop
End Sub

【完】

由于博主水平有限，编辑工作中难免有疏误之处，自知代码臃肿，有很大的优化空间，竭诚欢迎读者批评指正。

声明：本文档所引用的表格仅作演示，本案例只是提供了解决工作中问题的通用思路，只适合作为技术交流，勿用于资料造假。截图中的桩号和数据是随手编辑，并非真实数据。