龔其琛，章 恒

（1.中南勘察設(shè)計(jì)院（湖北）有限責(zé)任公司，湖北 武漢 430000）

地理國(guó)情普查基本統(tǒng)計(jì)工作的主要作業(yè)成果為基本統(tǒng)計(jì)報(bào)告，目前基本統(tǒng)計(jì)報(bào)告的版本為V1.1。使用該基本統(tǒng)計(jì)軟件能夠生成基于地理國(guó)情普查數(shù)據(jù)庫(kù)的各種地類長(zhǎng)度、面積統(tǒng)計(jì)報(bào)表，但報(bào)表數(shù)據(jù)存放結(jié)構(gòu)自成一體，且其長(zhǎng)度、面積單位和基本統(tǒng)計(jì)規(guī)范所規(guī)定的報(bào)告使用單位不一致，因此人工填寫報(bào)告面臨兩 個(gè)問(wèn)題，即查找數(shù)據(jù)和轉(zhuǎn)換單位。通過(guò)對(duì)基本統(tǒng)計(jì)報(bào)告和基本統(tǒng)計(jì)報(bào)表的結(jié)構(gòu)分析，本文采用Excel VBA編寫了自動(dòng)提取數(shù)據(jù)和單位轉(zhuǎn)換的宏腳本，以減少人工工作量和出錯(cuò)率。

1 軟件介紹

1）Excel。Microsoft Excel是微軟公司辦公軟件Microsoft Office的組件之一，是Microsoft為Windows和Apple Macintosh操作系統(tǒng)的電腦編寫和運(yùn)行的一款試算表軟件。Excel可進(jìn)行各種數(shù)據(jù)的處理、統(tǒng)計(jì)分析和輔助決策操作，是微軟辦公組件的一個(gè)重要組成部分，被廣泛地應(yīng)用于管理、統(tǒng)計(jì)財(cái)經(jīng)、金融等眾多領(lǐng)域。

2）Excel VBA。VBA即新一代標(biāo)準(zhǔn)宏語(yǔ)言，是一 種編程通用的自動(dòng)化語(yǔ)言。VBA基于Visual Basic for Windows發(fā)展而來(lái)的，是Visual Basic的子集。Visual Basic是由Basic發(fā)展而來(lái)的第4代編程語(yǔ)言。VBA不但繼承了Visual Basic的開發(fā)機(jī)制，而且與其有著相似的語(yǔ)言結(jié)構(gòu)和開發(fā)環(huán)境。在VBA產(chǎn)生之前，Excel、Word等都有各自的編程語(yǔ)言供用戶進(jìn)行再開發(fā)，但語(yǔ)言各不相同且互不兼容，需要用戶針對(duì)不同的應(yīng)用軟件學(xué)習(xí)各自的編程語(yǔ)言，這樣就使得應(yīng)用軟件在程序上不能互聯(lián)，VBA的產(chǎn)生圓滿解決了這個(gè)問(wèn)題。

2 作業(yè)思路

2.1 出圖數(shù)據(jù)提取

2.1.1 作業(yè)要求

在基本統(tǒng)計(jì)報(bào)告編寫過(guò)程中，需要制作統(tǒng)計(jì)對(duì)象的專題統(tǒng)計(jì)地圖，如轄區(qū)植被覆蓋、水系及道路面積等。圖1為植被覆蓋統(tǒng)計(jì)地圖。

圖1 基本統(tǒng)計(jì)報(bào)告插圖樣例

從圖1可以看出，制作該圖需要基于地理國(guó)情普查數(shù)據(jù)庫(kù)中BOUA6，將出圖所需的數(shù)據(jù)（圖1中則是耕地、園地、林地、草地在各鎮(zhèn)的面積以及植被覆蓋占比）以鎮(zhèn)、街為單位整理；再使用ArcGIS或其他GIS軟件將數(shù)據(jù)連接到BOUA6中。各地類面積、長(zhǎng)度數(shù)據(jù)基于基本統(tǒng)計(jì)軟件所生成的基本統(tǒng)計(jì)報(bào)表提取，而基本統(tǒng)計(jì)報(bào)表將不同地類信息存放在不同工作表中，如圖2所示，可以看出，統(tǒng)計(jì)信息分布規(guī)則自成體系，人工拷貝數(shù)據(jù)所需工作量較大，且容易出錯(cuò)。

2.1.2 作業(yè)過(guò)程

鑒于人工提取數(shù)據(jù)工作量巨大，因此本文采用Excel VBA自動(dòng)提取基本統(tǒng)計(jì)報(bào)表中的數(shù)據(jù)，并以鎮(zhèn)、街為單位將其一一對(duì)應(yīng)，然后使用GIS軟件進(jìn)行屬性連接并出圖。其工作思路如圖3所示。

圖2 基本統(tǒng)計(jì)報(bào)表數(shù)據(jù)分布結(jié)構(gòu)（部分）

圖3 基本統(tǒng)計(jì)出圖數(shù)據(jù)掛接流程圖

出圖流程中的核心工作為使用Excel VBA將不帶屬性的BOUA6圖層掛接上各地類面積、長(zhǎng)度等屬性信息，用以制作各類地理圖。掛接屬性所需要的模板如圖4所示。

圖4 掛接屬性模板示例（部分）

設(shè)定好掛接屬性模板后，使用Excel VBA在基本統(tǒng)計(jì)報(bào)表中讀取縣、區(qū)所有鎮(zhèn)、街名稱，并放置到A列（行政區(qū)域列），然后根據(jù)行政區(qū)域中行政區(qū)域?qū)傩砸约暗仡惷Q兩個(gè)要素從基本統(tǒng)計(jì)報(bào)表各工作表中讀取相應(yīng)的數(shù)據(jù)。讀取數(shù)據(jù)的代碼為：

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim i, j, m As Integer

Dim shtOutput As String

‘設(shè)定打開基本統(tǒng)計(jì)報(bào)表的數(shù)據(jù)框

Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)

fd.AllowMultiSelect = False

fd.Show

Workbooks.Open (fd.SelectedItems.Item(1))

shtOutput = ActiveWorkbook.Name

With Workbooks("圖式屬性表.xlsm").Worksheets("出圖所需數(shù)據(jù)匯總")

‘獲取行政區(qū)劃與管理的項(xiàng)目數(shù)

j = 8

Do Until Workbooks(shtOutput).Sheets("地基6-5表").Cells(j, 1).Value <> "行政區(qū)劃與管理"

j = j + 1

Loop

j = j - 1

‘在“出圖所需數(shù)據(jù)匯總工作表”中獲取各鎮(zhèn)名稱

For i = 2 To j - 6

.Cells(i, 1).Value = Workbooks(shtOutput).Worksheets("地基6-5表").Cells(i + 6, 3).Value

Next

‘獲取行政區(qū)面積

.Activate

.Range("b2").Select

ActiveCell.FormulaR1C1 = _

"=INDEX('[" & shtOutput & "]地 基7-1表'!C5,MATCH(RC1,'[" & shtOutput & "]地基7-1表'!C3,0))"

.Range("b2").Select

Selection.AutoFill Destination:=.Range("b2:b50"),Type:=xlFillDefault

‘獲取各鎮(zhèn)植被覆蓋數(shù)據(jù)(耕地、 園地、草地、林地)

For i = 8 To 1000

Workbooks(shtOutput).Sheets("地基2-1表").Cells(i, 12).Value= Workbooks(shtOutput).Sheets("地基2-1表").Cells(i, 3).Value &Workbooks(shtOutput).Sheets("地基2-1表").Cells(i, 5).Value

Next

.Activate

.Range("C2").Select

ActiveCell.FormulaR1C1 = _

"=INDEX('[" & shtOutput & "]地基2-1表'!C9,MATCH(RC1&R1C,'[" & shtOutput & "]地基2-1表'!C12,0))"

.Range("C2").Select

Selection.AutoFill Destination:=.Range("C2:F2"),Type:=xlFillDefault

.Range("C2:F2").Select

Selection.AutoFill Destination:=.Range("C2:F50"),Type:=xlFillDefault

‘獲取各鎮(zhèn)水域數(shù)據(jù)

For i = 8 To 1000

Workbooks(shtOutput).Sheets("地基3-3表").Cells(i, 12).Value= Workbooks(shtOutput).Sheets("地基3-3表").Cells(i, 3).Value &Workbooks(shtOutput).Sheets("地基3-3表").Cells(i, 5).Value

Next

（其他地類提取代碼略過(guò)）

End With

Workbooks(shtOutput).Close True

Application.ScreenUpdating = True

MsgBox ("完成")

End Sub

在Excel 中設(shè)置宏快捷鍵或插入宏激活按鈕連接此段代碼，即可對(duì)基本統(tǒng)計(jì)報(bào)表中數(shù)據(jù)進(jìn)行自動(dòng)提取，運(yùn)行過(guò)程及效果圖如圖5、6所示。

圖5 數(shù)據(jù)提取宏運(yùn)行截圖

圖6 數(shù)據(jù)提取宏運(yùn)行結(jié)果（部分）

采用插入宏ActiveX按鈕的方式激活宏代碼，開始運(yùn)行之后選取相應(yīng)的基本統(tǒng)計(jì)報(bào)表，點(diǎn)擊“打開”自動(dòng)運(yùn)行并提取數(shù)據(jù)，數(shù)據(jù)提取結(jié)果如圖6所示，將各地類面積、長(zhǎng)度等屬性以鎮(zhèn)、街為單位匯總成表，建立BOUA6層NAME字段與此表行政區(qū)域的對(duì)應(yīng)關(guān)系，可輕易地把地類屬性連接起來(lái)用于出圖。

2.2 單位轉(zhuǎn)換

2.2.1 作業(yè)要求

基本統(tǒng)計(jì)過(guò)程中，需要使用到基本統(tǒng)計(jì)軟件生成的基本統(tǒng)計(jì)報(bào)表，但基本統(tǒng)計(jì)技術(shù)規(guī)范規(guī)定基本統(tǒng)計(jì)報(bào)告中面積單位均采用km2且保留3位小數(shù)，而基本統(tǒng)計(jì)報(bào)表中單位為m2；基本統(tǒng)計(jì)報(bào)告中長(zhǎng)度均采用km且保留兩位小數(shù)，而基本統(tǒng)計(jì)報(bào)表中單位為m。若在編寫報(bào)告時(shí)直接基于基本統(tǒng)計(jì)報(bào)表進(jìn)行人工轉(zhuǎn)換，既容易出錯(cuò)又會(huì)花費(fèi)較大的時(shí)間成本，因此采用Excel VBA的形式編寫單位轉(zhuǎn)換、自動(dòng)取位代碼，將轉(zhuǎn)換出來(lái)的數(shù)據(jù)直接復(fù)制使用。

2.2.2 作業(yè)過(guò)程

使用Excel VBA編寫的單位轉(zhuǎn)換模塊運(yùn)行界面如圖7所示。

圖7 單位轉(zhuǎn)換模塊截圖

將編寫完成的單位轉(zhuǎn)換宏設(shè)置為快捷鍵（如Ctrl+S），在報(bào)告編寫過(guò)程中，需要使用報(bào)表中的面積時(shí)，將待進(jìn)行單位轉(zhuǎn)換的單元格選中，按下Ctrl+S，在跳出的對(duì)話框中選擇“m2-km2”即可在報(bào)表的最后一 行自動(dòng)生成單位轉(zhuǎn)換后且已自動(dòng)取位的面積，m轉(zhuǎn)km也是相同的操作方法。 延長(zhǎng)小數(shù)位選項(xiàng)用于報(bào)表中保留兩 位小數(shù)的面積占比等不需要轉(zhuǎn)換單位的數(shù)值，由于基本統(tǒng)計(jì)規(guī)范要求保留兩位小數(shù)，在保留兩位會(huì)將大于0的數(shù)值保留為0.00的情況下，此選項(xiàng)能自動(dòng)延長(zhǎng)小數(shù)位以保證面積占比大于0。其詳細(xì)代碼為：

Private Sub OptionButton1_Click()

‘m-km

On Error Resume Next

Dim i As Integer

Dim rg As Range

With ActiveWorkbook.ActiveSheet

i = .Range("a8").CurrentRegion.Columns.Count + 1

For Each rg In Selection

‘若單位轉(zhuǎn)換成果取兩位小數(shù)不為0則直接取位

If CDbl(rg.Value) / 1000 >= 0.005 Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000 +0.0000001, 2)

Else

‘若單位轉(zhuǎn)換成果取兩位小數(shù)為0，則通過(guò)NumberCal函數(shù)判定小數(shù)點(diǎn)后第一個(gè)有效數(shù)字位數(shù)靈活取位

j = NumberCal(CDbl(rg.Value) / 1000)

If Round(CDbl(rg.Value) / 1000 + 0.0000000000001, j - 1) =0# Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000 +0.000000001, j)

Else

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000 +0.000000001, j - 1)

End If

End If

Next

End With

UserForm1.Hide

End Sub

Private Sub OptionButton2_Click()

‘m2- km2

On Error Resume Next

Dim i, j As Integer

Dim rg As Range

With ActiveWorkbook.ActiveSheet

i = .Range("a8").CurrentRegion.Columns.Count + 1

For Each rg In Selection

‘若單位轉(zhuǎn)換成果取3位小數(shù)不為0則直接取位

If CDbl(rg.Value / 1000000) >= 0.0005 Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000000+ 0.00000001, 3)

Else

‘若單位轉(zhuǎn)換成果取3位小數(shù)為0，則通過(guò)NumberCal函數(shù)判定小數(shù)點(diǎn)后第一個(gè)有效數(shù)字位數(shù)靈活取位

j = NumberCal(CDbl(rg.Value) / 1000000)

If Round(CDbl(rg.Value) / 1000000 + 0.0000000000001, j -1) = 0# Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000000+ 0.000000001, j)

Else

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) / 1000000+ 0.000000001, j - 1)

End If

End If

Next

End With

UserForm1.Hide

End Sub

Private Sub OptionButton3_Click()

‘延長(zhǎng)小數(shù)位

On Error Resume Next

Dim i As Integer

Dim rg As Range

With ActiveWorkbook.ActiveSheet

i = .Range("a8").CurrentRegion.Columns.Count + 1

For Each rg In Selection

‘若數(shù)值取兩位小數(shù)不為0則直接取位

If CDbl(rg.Value) >= 0.005 Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) +0.000000001, 2)

Else

‘若數(shù)值取兩位小數(shù)為0，則通過(guò)NumberCal函數(shù)判定小數(shù)點(diǎn)后第一個(gè)有效數(shù)字位數(shù)靈活取位

j = NumberCal(CDbl(rg.Value))

If Round(CDbl(rg.Value) + 0.0000000000001, j - 1) = 0#Then

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) +0.00000000001, j)

Else

.Cells(rg.Row, i).Value = Round(CDbl(rg.Value) +0.00000000001, j - 1)

End If

End If

Next

End With

UserForm1.Hide

End Sub

Public Function NumberCal(ByVal a As Double) As Integer

‘使用正則表達(dá)式檢索有效數(shù)字位數(shù)的方式判定取位為0的數(shù)值小數(shù)點(diǎn)后第一次出現(xiàn)非0值的位置

Dim oRegExp As Object

Dim oMatches As Object

Dim i, j As Integer

Dim s As String

s = CStr(a)

Set oRegExp = CreateObject("vbscript.regexp")

With oRegExp

.Global = False

.Pattern = "[1-9]"

Set oMatches = .Execute(s)s = .Replace(s, "b")

i = InStr(s, ".")

j = InStr(s, "b")

End With

NumberCal = j - i

End Function

該宏代碼將“m-km”、“m2-km2”、“延長(zhǎng)小數(shù)位”分作3個(gè)模塊編寫，各模塊均用到一個(gè)NumberCal函數(shù)。該函數(shù)是一個(gè)自定義函數(shù)，通過(guò)正則表達(dá)式搜索1～9數(shù)值的方式查找數(shù)值小數(shù)點(diǎn)后第一個(gè)有效數(shù)字的位置，從而解決把較小小數(shù)取位為0.00或0.000的問(wèn)題。

3 結(jié) 語(yǔ)

本文通過(guò)在解決基本統(tǒng)計(jì)作業(yè)過(guò)程中遇到的數(shù)據(jù)提取與單位轉(zhuǎn)換問(wèn)題，展示了VBA在處理Excel格式數(shù)據(jù)中的巨大應(yīng)用潛力，將項(xiàng)目需求與Excel VBA相結(jié)合，在很多時(shí)候能極大地減少冗余工作量。Excel具有靈活、規(guī)范的數(shù)據(jù)處理能力，與ArcGIS等地理處理軟件能很好的互補(bǔ)，熟練掌握對(duì)日常的地理信息化作業(yè)有很大幫助。

[1] Microsoft Excel VBA 2010幫助文件[CP].美國(guó):微軟公司,2009

[2] 羅剛君. Excel VBA程序開發(fā)自學(xué)寶典 [M].第2版.北京:電子工業(yè)出版社,2009

[3] 魏汪洋. Excel VBA語(yǔ)法速查手冊(cè)[M].北京:化學(xué)工業(yè)出版社,2011

[4] 羅剛君. Excel VBA范例大全[M].北京:電子工業(yè)出版社,2008

[5] 王健. Excel表格直接轉(zhuǎn)換為MapGIS中報(bào)表的方法[J].地理空間信息,2010,8(5):144-145

[6] 朱向榮.基于Excel VBA的常用測(cè)量計(jì)算問(wèn)題解決方案[J].地理空間信息,2013,11(5):131-133

[7] 李德仁,邵振峰,丁霖.地理國(guó)情信息的多級(jí)網(wǎng)格化表達(dá)[J].地理空間信息,2014,12(1):1-5