淺談VBA在工作中的應(yīng)用

郝光前，周立新

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

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

1 幾個(gè)應(yīng)用實(shí)例

1．1 物探數(shù)據(jù)整理

在物探數(shù)據(jù)處理過程中，由于不同軟件對(duì)數(shù)據(jù)的格式要求不同，有時(shí)需要將以矩陣格式存貯的數(shù)據(jù)轉(zhuǎn)換為以X，Y，Z三列形式的存貯格式，如表1(a)部分和(b)部分所示。手工轉(zhuǎn)換起來比較繁瑣，尤其是數(shù)據(jù)量比較大的時(shí)候，但是通過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 同一數(shù)據(jù)的不同存貯格式

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

1．2 復(fù)雜數(shù)據(jù)的修改與排序

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

圖1 整理前界址點(diǎn)成果表

圖2 整理后界址點(diǎn)成果表

1．3 大量數(shù)據(jù)的分析與處理

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

圖3 某某縣國(guó)有單位權(quán)屬代碼

2 VBA在潛力評(píng)價(jià)中的應(yīng)用

2．1 問題的提出

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

圖4 航空磁測(cè)平面剖面圖

2．2 問題解決思路

從測(cè)線上的拐點(diǎn)(如A點(diǎn))向基線做垂線，其垂足坐標(biāo)(x，y)和垂線長(zhǎng)度h，即B(x，y，h)便是要從平剖圖中取得的數(shù)據(jù)，如圖5所示。要獲取B點(diǎn)的數(shù)據(jù)需要以下幾個(gè)步驟：

圖5 平剖圖中數(shù)據(jù)的提取

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

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

(3)建立求取B(x，y，h)點(diǎn)數(shù)據(jù)的數(shù)學(xué)模型，再根據(jù)第(2)步轉(zhuǎn)換后的2個(gè).xls文件進(jìn)行VBA程序代碼編寫。

2．3 數(shù)學(xué)模型建立及問題解決方案

2．3．1 數(shù)據(jù)模型的建立

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

圖6 基水平時(shí)

當(dāng)基線水平時(shí)，B點(diǎn)的值很容易求得：

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

圖7 基線垂直

當(dāng)基線垂直時(shí)，B點(diǎn)的值也很容易求得：

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

圖8 基線傾斜

當(dāng)基線傾斜時(shí)，為求得B點(diǎn)的值需要進(jìn)行幾步三角函數(shù)計(jì)算：已知坐標(biāo)的點(diǎn)為J1(x1，y1)，J2(x2，y2)，C(x0，y0)，∠α=∠β；由圖8可知，通過J1，J2可求得α的4個(gè)三解函數(shù)值sinα，cosα，tanα，ctanα。進(jìn)而給出所求點(diǎn)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點(diǎn)的值(x，y，h)。

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

圖9 基線分段情況

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

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

2．4 VBA程序編寫

由于把矢量數(shù)據(jù)轉(zhuǎn)換到Excel中后，包括數(shù)據(jù)格式的整理、錯(cuò)誤檢查、基線測(cè)線的分離、求取三角函數(shù)、形成最終結(jié)果整個(gè)過程都是用程序?qū)崿F(xiàn)的，篇幅過長(zhǎng)，下面僅給出求取三解函數(shù)和B點(diǎn)數(shù)據(jù)的關(guān)鍵代碼，僅供參考：

三角函數(shù)計(jì)算：

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點(diǎn)數(shù)據(jù)關(guān)鍵代碼：

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 處理結(jié)果

剖面圖經(jīng)過矢量化和VBA程序處理后的結(jié)果如表2所示。

表2 VBA程序整理后的數(shù)據(jù)結(jié)果

3 結(jié)論

該文針對(duì)數(shù)據(jù)處理中所遇到的重復(fù)性強(qiáng)、規(guī)律性強(qiáng)、數(shù)據(jù)量大的情況，根據(jù)工作的實(shí)際需求編寫了各種方式的程序算法，開展了一種新的嘗試，提供了一種新的思維方式。通過VBA集成系統(tǒng)編程，將一系列繁雜的工作簡(jiǎn)化為電腦自動(dòng)處理，計(jì)算過程只需一個(gè)按鍵就能輕松搞定，提高了工作效率，節(jié)約了人力成本。

參考文獻(xiàn)：

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

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

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

[4] 王瑞江.全國(guó)礦產(chǎn)資源潛力評(píng)價(jià)計(jì)劃項(xiàng)目2009-2010年總體實(shí)施方案[EB/OL].[2008-10-30].http://www.docin.com/p-24256628.html.

[5] 范正國(guó)，黃旭釗，熊盛青，等.磁測(cè)資料應(yīng)用技術(shù)要求[M].北京：地質(zhì)出版社，2010.

[6] 張明華，喬計(jì)花，劉寬厚，等.重力資料解釋應(yīng)用技術(shù)要求[M].北京：地質(zhì)出版社，2010.