基于VBA实现设计点位编号和坐标提取

冯伟华, 陈恩科, 张随安, 李怀敏

(1.陕西省地质调查中心, 西安 710014；2.陕西省地矿局 区域地质矿产研究院， 咸阳 712000)

0 前言

在1∶50 000、1∶200 000化探采样中，一般根据设计采样点位图人工量取设计点位坐标，再用GPS导航采取样品。作者诣在探讨利用计算机实现设计采样点位坐标的自动提取和填写样品编号，以提高野外生产效率和工作精度。坐标提取用MapGis软件来实现，样品编号用VBA语言编程实现，作者重点介绍用VBA编程填写样品编号的方法、流程。

1 坐标提取[1]

1.1 改变点属性结构

图1为一张经过校正的标准位置的的1∶50 000采样点位设计图，采样点文件为“设计采样点位.wt”点文件。选择“设计采样点位”点文件，为编辑状态。选择“点编辑—编辑属性结构”菜单。选择插入项，字段名称输入X，字段类型长整形，字段长度“8”，小数位数“0”，再插入一项，字段名称输入Y，其他同上，完成后点击“OK”选项，退出Mapgis。

1.2 点位置赋属性

利用数字填图软件打开设计采样点位图。选择“设计采样点位”点文件，为编辑状态。选择PRB数据操作-PRB-R过程计算与点坐标重写菜单见图1，点击点坐标写入。退出菜单，选择修改点属性结构，查看坐标写入状况(图1)，查看点属性，坐标已写入属性，x为6位数据、y为7位数据，退出数字填图。

1.3 导出点属性

打开MapGIS程序，选择投影变换窗口。选择“工具-属性生成文本文件”菜单，填写输出的文本文件的名称，见图2设置各项，完成属性输出。输出的文本文件有三项数据，ID号、X、Y。将文本文件转换为Excel格式，以备后续编写采样点编号使用。

2 填写样品编号

2.1 样品编号规则[2]

在1∶50 000化探中,样品编号分为三步：首先将图幅范围以纵横坐标,整公里方里网为界距划分为1 km2基本单元格，由左到右，由上到下依次顺序编号；再将每个1 km2基本单元格，以x、y500 m间距等分为四个0.25 km2小单元格，顺时针编号为a、b、c、d；在每个小单元格内按x坐标由小到大依次编号a1、a2等。因此一个样品编号(例1031a2)由三部分组成：一级编号(基本单元格号，1031)+二级编号(小单元格编号,a)+三级编号(2)。

图1 设计采样点位图及点位赋属性窗口Fig．1 Map of design of sampling point and window of point site to attribute

图2 属性输出窗口Fig．2 Output window of attributes

2.2 宏、VBA语言及重点函数介绍

“宏”是一些存储了一系列命令的程序，用户通过“宏”功能来创建命令程序，使应用程序自动化。 Visual Basic for Applications(VBA)是Visual Basic的一种宏语言，主要能用来扩展Windows的应用程序(Excel、Word等)功能，使应用程序自动化[3]。VBA语言可直接对Excel数据单元格和行、列进行操作，不必另行转换数据格式和定义二维数组存储数据，数据运算简便，运行速度高。本次编程涉及的VBA语言主要的方法、属性简要说明如表1所示。

2.3 数据存储

原始点位数据以Excel形式存储(图3)，第一行为标题行，A列、B列为设计点位坐标存储位置，A列为x值，B列为y值。C列到G列为程序运算过程中数据中间存储位置，C列为一级编码、D列为二级编码、E列为三级编码、F列、G列为对应的点位坐标。三级编码完成后，A列、B列为空值，整列删除，C列到E列合并为一列，为样品编号列，见图3右边为数据处理结束后存储格式。

2.4 程序流程

将整个采样点位看做分布于m行n列基本单元格内纵坐标由大到小，横坐标由小到大有序排列的二维数据阵，用双重循环控制，循环遍历全部数据。根据样点坐标与起始编码坐标的差值寻依次找第m行n列，第k个单元格内的点位数据；根据x坐标y坐标的后三位值确定二级编码值；一个单元格内点位数据提取完后，再次遍历该单元格内点位数据，确定三级编码值；一个单元格内数据完成编码后，将该单元格内的点位数据复制到其他列并从原数据中删除，以提高程序后续运行速度,程序流程见图4。

2.5 主要程序编码及说明

Sub 编码()

Dim ZRow As Long

′总行数

Dim STx, Endx As Long

′定义起始、结束

单元格x、y

Dim STy, Endy As Long

Dim Zh, Zl As Integer

′定义基本单元格的

总行，总列

Dim rng1 As Range

Fricode = 1

′一级编码赋初始值“1 ”

Set rng1 = ActiveCell.CurrentRegion

ZRow = rng1.Rows.Count

′获取Excel数

据的总行数

For n = 0 To Zh

′一重循环控制行

For m = 0 To Zl

′二重循环控制列

表1 主要的方法、属性简要说明[4]

图3 数据存储格式说明Fig．3 Shows the data storage format

Num = 0

′Num，记录该基本单元格内

设计样点数

Fricode = Fricode + p

′Fricode，记录

一级编码值，顺序编码

p = 0

For i = 2 To ZRow

′顺序遍历Excel数据

Dqx = Cells(i, 2).Value

′获取x坐标

Dqy = Cells(i, 3).Value

′获取y坐标

If (Dqx - STx) 1000 = m And (STy - Dqy) 1000 = n Then

′数据满足该单元格的条件

p = 1

′一级编码加1

AA(Num) = i

′AA( )数组记录满足条件的数据行号，以备后续删除该行数据

Num = Num + 1

。。。。。。。。

′判断二级编码值

Cells(j, 5).Value = Fricode

′将该单元格内点位数据复制到第j行8、9列；5，6列赋一、二级编码值。

Cells(j, 6).Value = Secode

Cells(j, 8).Value = Dqx

Cells(j, 9).Value = Dqy

Next i

For b = 1 To Num

′用双重循环确定该

单元格内Num个样点的三级编码值

。。。。。。。。

Next b

ZRow = ZRow - Num

For e = Num - 1 To 0 Step -1

′在原Excel数据中由后

向前删除已编码的Num个数据。

Range("A" & AA(e) & ":C" & AA(e)).Delete shift:=xlUp

Next e

Next m

′该单元格数据操作完成，开始提取该行下一个单元格的数据

Next n

′开始提取下一行，第一个单元格的数据

Range("A:B").Delete shift:=xlLe

′全部编码完成后，删除1-2列空白列。

End Sub

图4 程序流程图Fig．4 Flow chart of the program

3 程序运行

以四幅1∶50 000设计采样点位图为例，共设计采样点位11 721个，提取的点位坐标如图5所示。打开工具菜单，执行宏命令(图5)，弹出程序界面， 输入工作区范围、基本单元格间距，开始执行程序。完成全部编号需15 min左右。

图5 程序运行界面Fig．5 Interface of program running

4 说明

(1)在提取设计点位坐标时，所使用的设计采样点位图必须是经校正标准位置的图幅，提取的坐标x为6位、y为7位。

(2)程序中输入的起始、结束X、 Y为整公里值，基本单元间距单位为公里。

5 结论

(1)VBA语言针对Excel宏编程，语法简单，运算简便，运行效率高。

(2)程序的通用性较强，适用于 1∶50 000、 1∶200 000 等不同比例尺化探。

(3)该方法应用于实际生产，可有效地改善野外生产的精度，提高工作效率。

参考文献：

[1] 中国地质调查局发展研究中心，数字填图用户操作指南[M]．北京：中国地质调查发展中心,2000.

[2] DZ/TO 167-2006区域地球化学勘查规范[S].北京：中国标准出版社，2006．

[3] Excel VBA 基础教程[EB/OL]互联网百度文库．

[4] Excel VBA语法辞典[M].北京：机械工业出版社,2010.