基于VBA的農(nóng)村集體土地確權(quán)項(xiàng)目中地籍調(diào)查表的批量處理

摘 要：Visual Basicfor Applications（VBA）是Visual Basic的一種宏語言，是微軟開發(fā)出來在其桌面應(yīng)用程序中執(zhí)行通用的自動化（OLE）任務(wù)的編程語言。本文介紹了某縣農(nóng)村集體土地所有權(quán)確權(quán)登記發(fā)證項(xiàng)目中地籍調(diào)查表批量處理的相關(guān)難題，并結(jié)合實(shí)例，利用EXCELVBA編寫了若干代碼進(jìn)行處理。結(jié)果表明，基于EXCELVBA的編程方法在批量處理地籍調(diào)查表的工作中能大大提高效率，并能減少出錯(cuò)幾率。

關(guān)鍵詞：集體土地確權(quán)；地籍調(diào)查表；VBA

中圖分類號：F321.1 文獻(xiàn)標(biāo)識碼：A 文章編號：1004-7344（2018）26-0319-02

1 前 言

EXCEL VBA是EXCEL的宏編輯語言，是基于Visual Basic for Windows發(fā)展而來，VBA提供了面向?qū)ο蟮某绦蛟O(shè)計(jì)方法，易于學(xué)習(xí)掌握。

在某縣農(nóng)村集體土地確權(quán)項(xiàng)目內(nèi)業(yè)過程中，需要對數(shù)據(jù)庫軟件生成的海量以宗地為單位的不完善的地籍調(diào)查表進(jìn)行處理，包括增加共用面積分?jǐn)偙肀怼⒉鸱止灿腥嗣Q、填寫分?jǐn)偯娣e、填寫調(diào)查人、調(diào)查日期、修改部分錯(cuò)誤及打印成PDF等工作。

2 實(shí)例分析

某縣農(nóng)村集體土地所有權(quán)數(shù)據(jù)庫涉及8個(gè)鄉(xiāng)鎮(zhèn)，33248宗地。建庫軟件（蒼穹）自動生成了33248份格式統(tǒng)一的《地籍調(diào)查表》。由于入庫數(shù)據(jù)缺陷、建庫軟件的不完善和追加要求等原因，在現(xiàn)有的地籍調(diào)查表基礎(chǔ)上需要進(jìn)行一系列修改，具體有下面幾個(gè)方面。

（1）增加共用面積分?jǐn)偙?。根?jù)要求，每份地籍調(diào)查表在已有的“封面”、“基本信息”、“草圖”、“調(diào)查審核”四個(gè)工作表后額外增加一個(gè)“共用面積分?jǐn)偙怼?，且按相?yīng)要求填寫表格中的內(nèi)容，特別是宗地存在共有人的情況下，需對共有人進(jìn)行拆分，并分別統(tǒng)計(jì)獨(dú)有面積。

（2）補(bǔ)完表格缺失的內(nèi)容，并修改錯(cuò)誤的信息。主要針對“調(diào)查審核”表中，錯(cuò)誤的日期，未填寫的人名、日期等數(shù)據(jù)。

（3）打印地籍調(diào)查表。需對每個(gè)修改完畢的EXCEL格式的地籍調(diào)查表，按照工作表的順序打印成對應(yīng)名稱的獨(dú)立PDF文件。

3 VBA解決方案

針對所需要求，設(shè)計(jì)簡易可行的VBA代碼對地籍調(diào)查表進(jìn)行批量操作。下面為主要代碼（部分）。

3.1 增加共用面積分?jǐn)偙聿⑻顚憙?nèi)容

（1）增加表格

Worksheets.Add after：=Worksheets（\"調(diào)查審核\"）

ActiveSheet.Name = \"共用面積分?jǐn)偙韁"

（2）設(shè)置表格的基本樣式

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"a1：E1\"）.Merge

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"a1\"）.ColumnWidth = 15.5

Set RNG = Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"A1：E23\"）

RNG.Borders.LineStyle = xlContinuous

（3）各單元格賦值

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"a4\"）.Value = \"宗地面積/m2\"

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B4\"）.Value _

= Worksheets（\"基本信息\"）.Range（\"D23\"）.Value

（4）提取權(quán)利人中的共有人名稱（權(quán)利人名稱內(nèi)用逗號分隔的為共有人）

Dim z ，s

z = UBound（Split（Worksheets（\"基本信息\"）.Range（\"b2\"）， \"，\"， ， vbTextCompare））

s = Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B3\"）.Value

If z > 0 Then

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B6\"）.Value _

= Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B3\"）.Value

k = 1

m = 1

For j = 1 To Len（s）

If Mid（s， j， 1） = \"，\" Then

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B\" Trim（6 + m））.Value _

= Mid（s， k， j - k）

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"C\" Trim（6 + m））.Value _

= Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B4\"）.Value / （z + 1）

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"D\" Trim（6 + m））.Value _

= Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"B4\"）.Value / （z + 1）

Worksheets（\"共用面積分?jǐn)偙韁"）.Range（\"E\" Trim（6 + m））.Value = 0

k = j + 1

m = m + 1

End If

（5）填寫日期和人員，并修改錯(cuò)誤。

未填寫的內(nèi)容直接進(jìn)行單元格賦值，對于權(quán)屬調(diào)查記事里的錯(cuò)誤日期，采用查找替換的方式處理。為方便操作，添加一個(gè)按鈕和6個(gè)文本框。

部分代碼如下：

Worksheets（\"調(diào)查審核\"）.Range（\"E16\"）.Value = TextBox2.Text '調(diào)查日期

Worksheets（\"調(diào)查審核\"）.Range（\"C16\"）.Value = TextBox1.Text '調(diào)查員

Dim str1$， str2$

str1 = Worksheets（\"調(diào)查審核\"）.Range（\"b2\"）.Value

str2 = Replace（str1， TextBox5.Text， TextBox6.Text， 1， 2）

Worksheets（\"調(diào)查審核\"）.Range（\"b2\"）.Value = str2

（6）批量修改及打印地籍調(diào)查表。

把以上的代碼在所有的地籍調(diào)查表中執(zhí)行一遍，并把每個(gè)EXCEL格式的地籍調(diào)查表，打印成對應(yīng)文件名的PDF文件。

如文件名為“431321012028JA00018地籍調(diào)查表A4.xls”，打印為“431321012028JA00018地籍調(diào)查表A4.pdf”。代碼如下：

Dim MyData As DataObject

Dim mypath$， myname$

mypath = ThisWorkbook.Path \"＼\"

myname = Dir（mypath myname）

Do While myname <> \"\"

If myname <> ThisWorkbook.Name Then

Workbooks.Open Filename：=mypath myname

Set MyData = New DataObject

MyData.SetText Left（myname， Len（myname） - 4）

MyData.PutInClipboard

ActiveWorkbook.PrintOut Copies：=1， Collate：=True

ActiveWorkbook.Save

ActiveWorkbook.Close

End If

myname = Dir

Loop

4 結(jié) 語

在集體土地確權(quán)項(xiàng)目中的地籍調(diào)查表處理過程中，EXCEL VBA完成了對所需要操作的批量處理。使用正確的VBA代碼，能大大提高工作效率，并能減少人為出錯(cuò)的概率，且有較強(qiáng)的實(shí)用性。

收稿日期：2018-8-10