淺談VBA在工作中的應用

郝光前，周立新

(山東省物化探勘查院，山東 濟南 250013)

Visual Basic for Application(VBA)，可以認為VBA是非常流行的應用程序開發語言VISUAL BASIC(簡稱VB)的子集[1]。它與VB的主要區別在于VB具有自己的開發環境，而VBA必須寄生于已有的應用程序中，如Office家族中的組件等，在Office 2000及其更高版本中，VBA已嵌入其所有應用程序，包括Word，Excel，PowerPoint，Access，Outlook以及Project等。并在各自應用程序中，新增了Visual Basic編輯器。這樣，用戶無論是在Excel中，還是在Word中以至是在Access中都可以使用VBA編寫程序代碼，達到想要的結果，該文就以Excel中的VBA語言應用為主題[2]，淺談一下VBA在實際工作中的應用。

1 幾個應用實例

1．1 物探數據整理

在物探數據處理過程中，由于不同軟件對數據的格式要求不同，有時需要將以矩陣格式存貯的數據轉換為以X，Y，Z三列形式的存貯格式，如表1(a)部分和(b)部分所示。手工轉換起來比較繁瑣，尤其是數據量比較大的時候，但是通過VBA程序，幾行代碼就可以解決問題。

k=1

For i = 2 To 15

For j = 2 To 9

Sheet2.Cells(k, 1) = Sheet1.Cells(i, 1)

Sheet2.Cells(k, 2) = Sheet1.Cells(1, j)

Sheet2.Cells(k, 3) = Sheet1.Cells(i, j)

k=k+1

Next j

Next i

表1 同一數據的不同存貯格式

還有一種情況是假設在一個幾千行幾百列的矩陣數據集中存在有“空區”，所謂“空區”就是野外工作無法進行數據采集的地方，比如：河流內部、村莊等，這些“空區”所填寫的并非數字，而是漢字的名稱或空白，這種情況在程序處理中是不允許的，必須把“空區”填上空區特征值，這時以手工方式來查找，既費時費力，還容易出錯，若通過VBA程序來處理，一兩分種就可以解決。

1．2 復雜數據的修改與排序

有些軟件在應用的過程中會產生一些Excel格式的數據報表，但這些報表僅僅是數據結果的一個集合，有些地方并不符合人們使用的習慣，比如在城鎮地籍測量中的CASS軟件，它廣泛應用于地形圖、地籍成圖、工程測量3大領域[3]，使用CASS軟件生成的界址點成果表(圖1)，幾千個宗地都是以Sheet1，Sheet2……形式表示，既不直觀也無次序，若把宗地號的關鍵幾位作為Sheet的表名，然后再按順序進行排序，大大提高了報表的可讀性，通過手工方式來修改將會耗費大量的時間，且出錯率高，但通過編制VBA程序極短時間內就可整理出圖2所示的結果。

圖1 整理前界址點成果表

圖2 整理后界址點成果表

1．3 大量數據的分析與處理

在第二次土地調查中，需要對穿過每一個村的國有土地編制獨立的權屬代碼，一般的大型公路、河流、鐵路，部分地區還有油田、油井等都是國有土地，這類用地往往會穿過許多村莊，就一個中小市(縣)來說總圖斑數得上萬條，手工從其中挑出其國有單位再單獨編碼很不現實，而通過編制VBA程序，在十幾分鐘內即可完成國有單位權屬編碼，大大提高了工作效率。圖3最右側一欄即為單獨編碼后某某縣國有單位權屬代碼。

圖3 某某縣國有單位權屬代碼

2 VBA在潛力評價中的應用

2．1 問題的提出

全國礦產資源潛力評價，是我國礦產資源方面的一次重要的國情調查[4]，該工程涉及面廣，要求對以往的資料進行全面的研究和分析，通過物、化、遙和自然重砂等手段為各種礦產資源的儲量預測提供翔實可告的依據，而現存的一些20世紀90年代以前的資料只有紙介質，沒有“電子版”，如圖4，對非數字化的磁測資料進行數字化、矢量化，形成電子版圖件，通過MapGIS矢量化后進行轉換、用數字化儀進行數字化等[5,6]，而MapGIS矢量化后進行轉換并不能直接應用，還需要用程序進行一系列的計算。

圖4 航空磁測平面剖面圖

2．2 問題解決思路

從測線上的拐點(如A點)向基線做垂線，其垂足坐標(x，y)和垂線長度h，即B(x，y，h)便是要從平剖圖中取得的數據，如圖5所示。要獲取B點的數據需要以下幾個步驟：

圖5 平剖圖中數據的提取

(1)在MapGIS中用不同的顏色對基線和測線進行矢量化，并且兩兩配對的基線和測線賦以相同的屬性值，將來的數據處理時即可以通過顏色區分出基線和測線又可以通過屬性找到相對應的基線或測線，為了保證數據的提取精度在矢量化測線時宜多加一些點。

(2)通過VBA程序無法對MapGIS格式文件進行處理，必須把矢量化的線文件所有拐點坐標全部導出該文件轉到Excel中進行處理。通過MapGIS的文件轉換功能可以將線劃的拐點坐標轉城WAL格式(文本格式)，再在Excel中轉存成xls文件，屬性值可以直接導成xls文件。

(3)建立求取B(x，y，h)點數據的數學模型，再根據第(2)步轉換后的2個.xls文件進行VBA程序代碼編寫。

2．3 數學模型建立及問題解決方案

2．3．1 數據模型的建立

由于所求的數據需要由測線上的拐點向基線做垂線，而根據測線和基線的相對位置大體上有3種情況：基線水平(圖6)、基線垂直(圖7)、基線傾斜(圖8)，其中基線傾斜時在具體算法實現上傾角大于45°和小于45°還有所區別，大同小異，該文只以一種常見的情況加以說明。

圖6 基水平時

當基線水平時，B點的值很容易求得：

x=x0；y=y1；h=y0-y1

圖7 基線垂直

當基線垂直時，B點的值也很容易求得：

x=x1；y=y0；h=x0-x1

圖8 基線傾斜

當基線傾斜時，為求得B點的值需要進行幾步三角函數計算：已知坐標的點為J1(x1，y1)，J2(x2，y2)，C(x0，y0)，∠α=∠β；由圖8可知，通過J1，J2可求得α的4個三解函數值sinα，cosα，tanα，ctanα。進而給出所求點B的x，y，h三值的算法：

L0=(y1-y0)*ctanα

x3=x1-L0

h=(x3-x0) sinβ

L1=(x3-x0)cosβ*cosβ

L2=(x3-x0)cosβ*sinβ

x=x3-L1

y=y3-L2

即可求得B點的值(x，y，h)。

通過以上描述已經建立了剖面圖取數的數學模型。需要說明的是，有些情況基線并不是一條直線，需要分段計算三角函數，如圖9，∠α≠∠β，所以要以折點C為分界點分別求取三角函數。

圖9 基線分段情況

2．3．2 問題的解決方案

通過以上討論，就可以對經矢量化以后轉換到Excel的數據進行整理，先根據基線與測線的顏色特征將基線坐標和測線坐標拆分到2個Sheet表中，在基線坐標的SHEET表中計算出某條基線或某條基線不同分段的三角函數，然后再根據屬性值來確定某條基線所對應的測線，把三角函數值及端點坐標值添加到測線坐標值的后面，最后通過數學模型中的算法用VBA程序計算所求的數據。

2．4 VBA程序編寫

由于把矢量數據轉換到Excel中后，包括數據格式的整理、錯誤檢查、基線測線的分離、求取三角函數、形成最終結果整個過程都是用程序實現的，篇幅過長，下面僅給出求取三解函數和B點數據的關鍵代碼，僅供參考：

三角函數計算：

sinα=(Sheet2.Cells(i, 2) - Sheet2.Cells(i + 1, 2)) / Sqr((Sheet2.Cells(i, 2) - Sheet2.Cells(i + 1, 2)) * (Sheet2.Cells(i, 2) - Sheet2.Cells(i + 1, 2)) + (Sheet2.Cells(i, 1) - Sheet2.Cells(i + 1, 1)) * (Sheet2.Cells(i, 1) - Sheet2.Cells(i + 1, 1)))

cosα= (Sheet2.Cells(i, 1) - Sheet2.Cells(i + 1, 1)) / Sqr((Sheet2.Cells(i, 2) - Sheet2.Cells(i + 1, 2)) * (Sheet2.Cells(i, 2) - Sheet2.Cells(i + 1, 2)) + (Sheet2.Cells(i, 1) - Sheet2.Cells(i + 1, 1)) * (Sheet2.Cells(i, 1) - Sheet2.Cells(i + 1, 1)))

求取B點數據關鍵代碼：

If direct = "xia" Then

If Sheet1.Cells(i, 4) >= Sheet2.Cells(j, 2) Then

sinα= Sheet2.Cells(j, 4)

cosα= Sheet2.Cells(j, 5)

xvalue=Sheet2.Cells(j,1)

yvalue=Sheet2.Cells(j,2)

flag=1

Exit For

End If

If Sheet1.Cells(i, 4) <=Sheet2.Cells(j,2) And Sheet1.Cells(i, 4) >= Sheet2.Cells(j + 1, 2) And Sheet2.Cells(j, 3) = Sheet2.Cells(j + 1, 3) Then

sinα=Sheet2.Cells(j + 1, 4)

cosα=Sheet2.Cells(j+1,5)

xvalue=Sheet2.Cells(j+1,1)

yvalue=Sheet2.Cells(j+1,2)

'處理水平線

If sinα=0 Then

flag=1

Exit For

End If

sinα=Abs(sinα)

cosα=Abs(cosα)

x0=Sheet1.Cells(i,3)

y=Sheet1.Cells(i,4)

tx=-(yvalue-y)*cosα/sinα

x=xvalue-tx

h=(x0-x)*sinα

mx=(x0-x)*cosα*cosα+x

my=y-(x0-x)*cosα*sinα

If my

If Sheet2.Cells(j+2,3)<>Sheet2.Cells(j+1,3)

Then

sinα=Sheet2.Cells(j+1,4)

cosα=Sheet2.Cells(j+1,5)

xvalue=Sheet2.Cells(j+1,1)

yvalue=Sheet2.Cells(j+1,2)

Else

sinα=Sheet2.Cells(j+2,4)

cosα=Sheet2.Cells(j+2,5)

xvalue=Sheet2.Cells(j+2,1)

yvalue=Sheet2.Cells(j+2,2)

End If

If sinα=0 Then

flag=1

Exit For

End If

sinα=Abs(sinα)

cosα=Abs(cosα)

x0=Sheet1.Cells(i,3)

y=Sheet1.Cells(i,4)

tx=-(yvalue-y)*cosα/sinα

x=xvalue-tx

h=(x0-x)*sinα

mx=(x0-x)*cosα*cosα+x

my=y-(x0-x)*cosα*sinα

End If

Exit For

End If

2．5 處理結果

剖面圖經過矢量化和VBA程序處理后的結果如表2所示。

表2 VBA程序整理后的數據結果

3 結論

該文針對數據處理中所遇到的重復性強、規律性強、數據量大的情況，根據工作的實際需求編寫了各種方式的程序算法，開展了一種新的嘗試，提供了一種新的思維方式。通過VBA集成系統編程，將一系列繁雜的工作簡化為電腦自動處理，計算過程只需一個按鍵就能輕松搞定，提高了工作效率，節約了人力成本。

參考文獻：

[1] 百度百科.VBA[EB/OL].[2010-11-27].http://baike.baidu.com/view/88461.htm.

[2] 孫懷文，齊孔讓，孟煥梅.運用EXCEL及VBA語言快速智能地處理土工試驗數據[J].山東國土資源，2010，26(4)：29-31.

[3] 高潔，李云嶺，劉曉慶.CASS格式地籍數據入庫前的編輯與處理研究[J].山東國土資源，2011，27(4)：56-59.

[4] 王瑞江.全國礦產資源潛力評價計劃項目2009-2010年總體實施方案[EB/OL].[2008-10-30].http://www.docin.com/p-24256628.html.

[5] 范正國，黃旭釗，熊盛青，等.磁測資料應用技術要求[M].北京：地質出版社，2010.

[6] 張明華，喬計花，劉寬厚，等.重力資料解釋應用技術要求[M].北京：地質出版社，2010.