基于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.