VBA提高挂钩项目数据统计效率探讨.docVIP

VBA提高挂钩项目数据统计效率探讨 四川金色土地开发整理规划设计有限公司 段小鹏 摘要：挂钩项目中的一些数据录入、统计一般都手动操作，而且还容易出错。本文将通过一个VBA小程序高效实现踏勘编号自动转化为实际上图编号的操作。 关键词：挂钩；VBA；踏勘编号 在实现本文所写的程序之前，笔者已结合MAPINFO（须小程序）和MAPGIS各自优势在MAPGIS中自动标注（地块编号和面积）完成。程序所需的EXCEL文件中已经输入踏勘编号和对应的户主、村名、人数等，踏勘编号和实际图上编号对应关系也已经录入。程序将在EXCEL宏中写入。 EXCEL宏快捷键：CTRL+W 程序定义变量： Dim i, j, NUM_shuzu, NUM_pd As Integer 对应关系数组最大下标和预处理数组最大下标 Dim s1, s2, d_ts As String 存储循环单元格 错误提示 Dim d_shuzu(400, 1) As String 存取踏勘编号和图上编号的对应关系 Dim d_pd(400) As String 预处理数组 录入存取踏勘编号和上图编号的对应关系： 从R_1单元格开始到R_MaxNumber录入踏勘编号 从S_1单元格开始到S_MaxNumber录入实际上图编号 For i = 1 To 400 s1 = R i s2 = S i d_shuzu(i - 1, 0) = Range(s1).FormulaR1C1 d_shuzu(i - 1, 1) = Range(s2).FormulaR1C1 If (Range(s1).FormulaR1C1 = ) Then NUM_shuzu = i - 2 Exit For End If Next i 判断、预处理、结果： A列是已经录入的踏勘编号。 结果将在B列从B1单元格开始生成与A1格相对应的实际上图编号。 1 如果目标列和存储列个数不一致（踏勘编号对不上），给予提示： MsgBox 踏勘编号个数不一样，请检查后再使用~~~~, , 友情提示--By xiaod 实际运行图1： 2 如果目标列和存储列个数一样但是其中某一个不对，并给予提示： MsgBox 踏勘编号个数一样，但其中有个别错误 Chr(10) Chr(13) 如：踏勘编号 d_ts, , 友情提示--By xiaod 实际运行图2： 3 如果目标列和存储列个数一样，且能完全对上，给予提示： MsgBox 踏勘编号完全能对上,点击确定开始生成.....！(ˇ_ˇ） , , 友情提示--By xiaod 实际运行图3： 核心代码： If (NUM_shuzu = NUM_pd) Then For i = 0 To NUM_shuzu If (d_shuzu(i, 0) d_pd(i)) Then j = 0 d_ts = d_shuzu(i, 0) End If Next i If (j = 1) Then MsgBox 踏勘编号完全能对上,点击确定开始生成.....！(ˇ_ˇ） , , 友情提示--By xiaod j = 0 For i = 1 To 10000 s1 = A i s2 = B i If (Range(s1).FormulaR1C1 = ) Then Exit For End If If (Range(s1).FormulaR1C1 = d_shuzu(j, 0)) Then Range(s2).FormulaR1C1 = d_shuzu(j, 1) Else j = j + 1 Range(s2).FormulaR1C1 = d_shuzu(j, 1) End If Next i Else MsgBox 踏勘编号个数一样，但其中有个别错误 Chr(10) Chr(13) 如：踏勘编号 d_ts, , 友情提示--By xiaod End If Else MsgBox 踏勘编号个数不一样，请检查后再使用~~~~, , 友情提示--By xiaod End If 结束语： 在土地整理很多方面可以利用程序简化实际操作，从而提高工作效率，并且不容易出错。本文通过对此研究，希望能给土地工作者一点有用的帮助。