勘测定界测量中土地分类面积汇总程序设计.docVIP

勘测定界测量中土地分类面积汇总程序设计 　　摘要：利用EXCEL VBA编程解决土地勘测定界测量中有土地分类面积汇总问题。 　　关键词：EXCEL VBA，测量，勘测定界，土地分类面积汇总，程序设计 　　中图分类号：S611 文献标识码： A 　　引言 　　在土地勘测定界测量中有汇总土地分类面积的工作要求，这项工作重复性极大，EXCEL原有功能不能尽快的完成任务。为解决这个问题特进行VBA二次开发以尽快解决土地分类面积汇总统计工作。 　　1、准备工作 　　将勘测定界图上各图斑权属与地类代码，按下表格式输入EXCEL表格（图1） 　　2、程序设计 　　2.1程序设计在EXCEL VBA编程环境内进行 　　使用程序语言为VBA语言，连接EXCEL对象模型库进行工作。 　　2.2 程序界面设计 　　如下： 　　2.3程序工作流程 　　第一步 读取源数据区的权属单位、土地分类代码及地类面积； 　　第二步 统计数据内包含的权属单位和地类代码； 　　第三步 按国家土地分类规范，以地类代码为引，搜索各地类代码所代表的地类名称和排列顺序； 　　第四步 按权属单位和地类代码进行面积统计； 　　第五步 将统计结果显示在结果存放区并设置结果格式。 　　2.4程序运行效果 　　结论 　　未使用本程序之前要通过对EXCEL表格进行排序，共统计权属单位数乘以地类数的乘积个合计数字，而且还要手工一个个拷贝到结果区域。 　　使用该程序后，无论多少权属单位和地类数，一键完成，极大的提高了土地分类面积的统计效率，受到了单位领导的好评。 　　参考文献： 　　[1]韩小良，韩舒婷.，EXCEL VBA（2003/2007）高效办公实用宝典，北京： 中国铁道出版社，2009 　　源程序主要代码如下： 　　Private Sub CommandButton1_Click（） 　　Dim data As String 　　data = rd1.Value 　　Dim red As Range 　　定义源数据区 　　Set red = Range（data） 　　drow = red.rows.Count 　　ReDim qs（drow） As String， tdfl（drow） As String 　　Dim numqs As Integer， numfl As Integer， bz As Boolean 　　统计权属单位数和土地分类数 　　numqs = 0 　　numfl = 0 　　For ii = 1 To drow 　　If ii = 1 Then 　　qs（numqs） = red.Cells（ii， 1） 　　tdfl（numfl） = red.Cells（ii， 2） 　　numqs = numqs + 1 　　numfl = numfl + 1 　　Else 　　bz = False 　　For jj = 0 To numqs - 1 　　If qs（jj） = red.Cells（ii， 1） Then 　　bz = True 　　Exit For 　　End If 　　Next jj 　　If bz True Then 　　qs（numqs） = red.Cells（ii， 1） 　　numqs = numqs + 1 　　End If 　　bz = False 　　For jj = 0 To numfl - 1 　　If tdfl（jj） = red.Cells（ii， 2） Then 　　bz = True 　　Exit For 　　End If 　　Next jj 　　If bz True Then 　　tdfl（numfl） = red.Cells（ii， 2） 　　numfl = numfl + 1 　　End If 　　End If 　　Next ii 　　ReDim gw（numqs， numfl） As Double 　　For ii = 1 To numqs - 1 　　For jj = 1 To numfl - 1 　　gw（ii， jj） = 0 　　Next jj 　　Next ii 　　进行土地分类排序 　　Dim nds As Integer， jds As Integer， wds As Integer 　　tdflpx tdfl（）， numfl， nds， jds， wds 　　按权属和地类进行面积统计 　　For ii = 1 To drow 　　For jj = 0 To numqs - 1 　　If red.Cells（ii， 1） =