浅谈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.