电子表格VBA编程计算速成1-4

电子表格VBA编程计算速成（1）
第一章电子表格专业函数编程
1.1 如何把“度.分秒”角度变成弧度？
在Excel 中，自带了大量的商务、办公标准函数，唯独没有把“度.分秒”角度变成“弧度”和将“弧度”转换为“度.分秒”或“°′″”这样的专业计算函数。

在测绘、工程、科学计算中，这经常是一个无法回避的问题。

怎么办？打开Excel，选择“工具”→“宏”→“Visual Basic编辑器”→“帮
助”→“Visual Basic语言参考”→“语句”→“A-L” →“Function”，就可以详细看到编写函数“Function”的相关语法：
[Public | Private | Friend] [Static] Function name [(arglist)] [As type] [statements]
[name=expression]
[Exit Function]
[statements]
[name=expression]
End Function
Function语句的语法包含下面部分：
部分描述
Public可选的。

表示所有模块的所有其它过程都可访问这个
Function 过程。

如果是在包含Option Private 的模块中使
用，则这个过程在该工程外是不可使用的。

Private可选的。

表示只有包含其声明的模块的其它过程可以访问该
Function 过程。

Friend可选的。

只能在类模块中使用。

表示该Function 过程在整个工程中都是可见的，但对于对象实例的控制者是不可见
的。

Static可选的。

表示在调用之间将保留Function 过程的局部变量值。

Static 属性对在该Function 外声明的变量不会产生影
响，即使过程中也使用了这些变量。

name必需的。

Function 的名称；遵循标准的变量命名约定。

arglist可选的。

代表在调用时要传递给Function 过程的参数变量
列表。

多个变量应用逗号隔开。

type可选的。

Function 过程的返回值的数据类型，可以是Byte、Boolean 、Integer、Long、Currency、Single、Double、
Decimal（目前尚不支持）、Date、String（除定长）、Object、
Variant或任何用户定义类型。

statements可选的。

在Function 过程中执行的任何语句组。

expression可选的。

Function 的返回值。

其中的arglist参数的语法以及语法各个部分如下：
[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
部分描述
Optional可选的。

表示参数不是必需的。

如果使用了该选项，则arglist 中的后续参数都必须是可选的，而且必须都使用Optional
关键字声明。

如果使用了ParamArray，则任何参数都不能
使用Optional 声明。

ByVal可选的。

表示该参数按值传递。

ByRef可选的。

表示该参数按地址传递。

ByRef是Visual Basic 的
缺省选项。

ParamArray可选的。

只用于arglist的最后一个参数，指明最后这个参
数是一个Variant 元素的Optional 数组。

使用
ParamArray关键字可以提供任意数目的参数。

ParamArray关键字不能与ByVal，ByRef，或Optional
一起使用。

varname必需的。

代表参数的变量的名称；遵循标准的变量命名约定。

type可选的。

传递给该过程的参数的数据类型；可以是Byte、Boolean、Integer、Long、Currency、Single、Double、
Decimal（目前尚不支持）、Date、String（只支持变长）、
Object 或Variant。

如果参数不是Optional，则也可以是
用户定义类型，或对象类型。

defaultvalue可选的。

任何常数或常数表达式。

只对于Optional参数时
是合法的。

如果类型为Object，则显式缺省值只能是
Nothing。

说明
如果没有使用Public、Private 或Friend显式指定，则Function过程缺省为公用。

如果没有使用Static，则局部变量的值在调用之后不会保留。

Friend关键字只能在类模块中使用。

但Friend过程可以被工程的任何模块中的过程访问。

Friend过程不会在其父类的类型库中出现，且Friend过程不能被后期绑定。

小心Function 过程可以是递归的；也就是说，该过程可以调用自己来完成某个特定的任务。

不过，递归可能会导致堆栈上溢。

通常Static关键字和递归的Function 过程不在一起使用。

所有的可执行代码都必须属于某个过程。

不能在另外的Function、Sub 或Property 过程中定义Function 过程。

Exit Function 语句使执行立即从一个Function 过程中退出。

程序接着从调用该Function 过程的语句之后的语句执行。

在Function 过程的任何位置都可以有Exit Function语句。

Function 过程与Sub 过程的相似之处是：Function 过程是一个可以获取参数，执行一系列语句，以及改变其参数值的独立过程，而与子过程不同
的是：当要使用该函数的返回值时，可以在表达式的右边使用Function 过程，这与内部函数，诸如Sqr、Cos或Chr的使用方式一样。

在表达式中，可以通过使用函数名，并在其后用圆括号给出相应的参数列表来调用一个Function 过程。

请参阅Call语句关于如何调用Function 过程的详细说明。

要从函数返回一个值，只需将该值赋给函数名。

在过程的任意位置都可以出现这种赋值。

如果没有对name 赋值，则过程将返回一个缺省值：数值函数返回0，字符串函数返回一个零长度字符串("")，Variant函数则返回Empty。

如果在返回对象引用的Function 过程中没有将对象引用赋给name （通过Set），则函数返回Nothing。

下面的示例说明如何给一个名为BinarySearch 的函数赋返回值。

在这个示例中，将False赋给了该函数名，表示没有找到某个值。

Function BinarySearch(. . .) As Boolean
. . .
'值未找到，返回一个False 值。

If lower > upper Then
BinarySearch = False
Exit Function
End If
. . .
End Function
在Function 过程中使用的变量分为两类：一类是在过程内显式声明的，另一类则不是。

在过程内显式声明的变量（使用Dim或等效方法）都是局部变量。

对于那些没有在过程中显式声明的变量，除非它们在该过程外更高级别的位置有显示地声明，否则也是局部的。

小心过程可以使用没有在过程内显式声明的变量，但只要有任何在模块级别中定义的名称与之相同，就会产生名称冲突。

如果过程中使用的未声明的变量与另一个过程，常数，或变量的名称相同，则会认为过程使用的是模块级的名称。

显式声明变量就可以避免这类冲突。

可以使用Option Explicit 语句来强制显式声明变量。

小心Visual Basic 可能会重新安排数学表达式以提高内部效率。

若Function 过程会改变某个数学表达式中变量的值，则应避免在此表达式中使用该函数。

Function 语句示例
该示例使用Function语句来声明Function过程的名称、参数、以及构成Function过程主体的代码。

最后一个例子中使用了确定类型的、初始化的Optional参数。

'下面的用户自定义函数返回
'它的参数的平方根。

Function CalculateSquareRoot(NumberArg As Double) As Double
If NumberArg < 0 Then '评估参数。

Exit Function'退出调用过程。

Else
CalculateSquareRoot = Sqr(NumberArg) '返回平方根。

End If
End Function
使用ParamArray关键字可以使函数接收数目可变的参数。

在下面的定义中，FirstArg是按值传递的。

Function CalcSum(ByVal FirstArg As Integer, ParamArray OtherArgs()) Dim ReturnValue
'如果用如下代码调用该函数：
ReturnValue = CalcSum(4, 3 ,2 ,1)
'则局部变量被赋予以下值：FirstArg = 4，
'OtherArgs(1) = 3，OtherArgs(2) = 2，等等。

'假设缺省数组下界 = 1。

Optional参数可以带缺省值，可以是除Variant 之外的任何类型。

'如果函数的参数定义如下：
Function MyFunc(MyStr As String, Optional MyArg1 As _ Integer = 5, Optional MyArg2 = "Dolly")
Dim RetVal
'则可用如下代码调用该函数：
RetVal = MyFunc("Hello", 2, "World") '提供了所有 3 个参数。

RetVal = MyFunc("Test", , 5) '省略了参数 2。

'参数 1 和参数 3 使用了命名的参数。

RetVal = MyFunc(MyStr:="Hello ", MyArg1:=7)
***************************************************************** ***
请认真反复学习和理解Function语句的语法和示例。

我们的任务是编制自己的专业函数去完成特定的专业计算任务。

编制把“度.分秒”角度变成弧度的函数自然是公用的，用于进行通用三角函数的计算，用Public（公用的）声明；参数通过关键字ByVal（通过值）声明，选择按值传递，是因为按值传递，改变过程内部的参数时将不会影响到原来的变量，所以，我们的专业计算函数的编程的一般格式应为：
Public Function Rad(ByVal angle As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim ang As Double, sign As Integer
ang = Abs(angle) + 0.0000000000001: sign = Sgn(angle)
A = Int(ang):
B = (ang - A) * 100#:
C = Int(B):
D = (B - C) * 100#
Rad = sign * (A + C / 60# + D / 3600#) * M_RAD
End Function
说明：
第1行：表示定义函数名为弧度Rad；参数angle按值传递，数据类型为双精度Double，函数的返回值的数据类型也是Double；
第2～6行：函数的语句体，其中：
第2～3行：用Dim语句，声明函数过程变量A,B,C,D,ang的数据类型为双精度型Double，sign为整型Integer；
第4～5行：“度.分秒”的角度值angle变换成十进制的度，其中调用了系统函数取绝对值Abs(x)，取±Sgn(x)，取整数Int(x)；
第6行：函数弧度Rad返回值；其中M_RAD是一常数，可用定义常数语句进行定义：
Public Const M_SEC# = 206264.8 '1弧度=206264.8″
Public Const M_DEG# = 57.2957795130823 '1弧度
=57.2957795130823°
Public Const M_RAD# = 1.74532925199433E-02 '1度
=1.74532925199433E-02弧度
Public Const M_PI# = 3.14159265358979 'π=3.14159265358979
第7行：函数结束语句。

接下来，就是进行模块代码输入、调试了：打开Excel的VB编辑器，选择“插入”→模块，在模块代码编辑窗口中输入：
Public Const M_SEC# = 206264.8 '1弧度=206264.8″
Public Const M_DEG# = 57.2957795130823 '1弧度
=57.2957795130823°
Public Const M_RAD# = 1.74532925199433E-02 '1度
=1.74532925199433E-02弧度
Public Const M_PI# = 3.14159265358979 'π=3.14159265358979
Public Function Rad(ByVal angle As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim ang As Double, sign As Integer
ang = Abs(angle) + 0.0000000000001: sign = Sgn(angle)
A = Int(ang):
B = (ang - A) * 100#:
C = Int(B):
D = (B - C) * 100#
Rad = sign * (A + C / 60# + D / 3600#) * M_RAD
End Function
上述带下划线（实际输入不带下划线）的项目（数据类型）在输入as加空格后会出现编辑提示窗口，继续输入do…就会出现double项，打空格键就上屏。

输入完毕，打开调试菜单→编译VBAProject，如果输入有误，即会弹出提示窗口，否则，函数编译成功！即可在Excel中像使用系统函数一样使用这个自编专业函数了。

1.2 学会编写函数过程
我们成功地编写了第一个把“度.分秒”角度变成“弧度”的函数RAD()。

这一个RAD()函数代表了将“度.分秒”角度转变成“弧度”的整个运算过程，所以，也把函数叫做Function过程。

一个应用程序就是有许许多多子过程和Function过程有机地组织起来的。

有了这个认识，让我们再举一个用三角截柱法进行土方计算的例子，学会将三角截柱法土方计算的过程变成函数。

要测算某工程区的平场土石方量：挖、填方量，用地形测量的方法，按一定的网度（15～30m）实测工程区内的地形变化点的三维坐标Xi、Yi、Hi，按
相邻、最近距的原则组成工程区三角网，每个三角形与平场面构成正（垂直）三角截柱体，计算出工程区所有三角截柱体的体积，即挖、填方量的总和，就是工程区的平场土石方量。

在整个计算过程中，单一的正三角截柱体的体积计算过程是共同的，将它编成函数：填方量Tfl()，挖方量Wfl()，这样，整个计算就简单了。

下面就来编写填方量函数Tfl()这个Function过程。

首先，在编写函数代码之前，必须先搞清楚计算填方量过程的具体过程和方法：
1，计算正三角截柱体体积的基本公式：见图7
Zsjjzv＝S·（h1+h2+h3）/3
2，工程区任一测点的标高或＞平场标高；或＜平场标高；或＝平场标高，下面是工程区任一测点的标高或＞平场标高；或＜平场标高可能出现的基本图形，此外还有任一测点的标高＝平场标高的情况。

不过，任一测点的标高＝平场标高和图7，图8可直接由公式求解；图1～图6中含四边形的图形必须分成三个正三角截柱体的特例图形（三角截柱体部分棱高＝0）分别解算。

3，此外，还要考虑连续解算（自动填充）自动终止的条件设置…。

4，填方量函数Tfl()的代码：参见1.4 自编函数示例D-25。

1.3 VBA程序调试
在设计VBA程序过程中，特别是设计复杂过程的程序，总会或多或少存在这样那样的错误，因此，需要对每一个自编函数、事件过程的VBA程序进行严格地调试，使程序运行结果与编程的预期结果完全一致，在专业的数值计算中，要特别注意数据和除数为0的情况的调试。

程序错误大致可分为以下几类：
语法错误：指程序的某一语句的语法出现错误，如左右引号或括号不匹配等。

当程序设计人员输入完一行语句时，Visual Baisc编辑器会自动检测语法错误，并提醒程序员错误所在。

编译错误：指在程序的编译过程中检测出来的错误。

只检测单行语句是不能发现编译错误的。

例如，以For Each开始的循环结构没有Next语句。

通常语法错误和编译错误是容易发现和改正的。

逻辑错误：指思维错误——导致程序运行结果与程序员的预期结果不同的编程思路错误。

例如，想把工作簿的标题改为“My Workbook”，却拼写成“My Werkbook”；应该是“>=”却写成“>”等等。

逻辑错误是最常见也是最麻烦的一类错误，程序调试的大部分时间都耗费在发现和纠正逻辑错误上。

一般可通过设置断点、单步执行、观察值的变化来发现和纠正逻辑错误。

实时错误：指在程序运行过程中发现的错误。

有时过程中的某条语句在某些条件下能正确执行，而在另一些条件下就不能正确执行。

例如，有一条语句除数是一个变量，设计时忽略了可能出现“0”值的情况，这样，程序运行时，当这个变量等于“0”时，就会出错。

在实时错误中，有些是Visual Baisc能指
出错误所在的，有些是程序员能预料的、能让Visual Baisc自动处理的。

在程序调试过程中，VBA提供了各种强有力的调试工具来查找和纠正错误。

1. 使用中断模式
中断模式是指在程序执行过程中被暂时停止。

此时所有变量、属性、表达式之值都维持在最新的状态，可以进行分析、测试或是重新设置等，以便检错纠错。

进入中断模式的方法有以下几种：
单步执行：按F8键。

单步执行类似在下一条语句上设置断点，执行当前语句并清除断点。

单步执行时，可观察每条语句的执行情况。

设置断点：单击要设置断点的语句行的左侧边界区域；或从“调试”菜单中选“切换断点”命令。

相应语句行左侧出现一个深红色圆点，该行也以深红色背景显示。

设置临时断点（即只用一次的断点）：单击要设置断点的语句行，从“调试”菜单中选“运行到光标处”命令。

在宏程序中需中断处加入Stop语句；在宏执行时，按Ctrl+Break键；在宏执行时，产生实时错误，程序自动进入中断模式。

符合〈监视表达式〉的条件与设定，程序进入中断模式。

2. 利用各种窗口
在VBA程序设计环境中，提供了“代码”窗口、“本地”窗口、“立即”窗口、“监视”窗口、“工程”窗口、“属性”窗口和“对象浏览器”窗口等7个窗口。

从“查看”菜单中选择相应的命令可以显示出这些窗口。

其中，“代码”窗口、“本地”窗口、“立即”窗口、“监视”窗口是调试程序的得力工具。

“代码”窗口：在中断模式下运行宏时，可以通过“代码”窗口来仔细地观察宏的执行过程，也可以通过将鼠标指针指向某变量来检测变量的值。

此时，在“代码”窗口内，准备执行的语句以黄色高亮方式显示，在其左边有一个黄色箭头。

“本地”窗口：在运行一个宏时，可以通过“本地”窗口观察宏程序所使用的变量、表达式、对象的变化来寻找程序错误；也可在“本地”窗口直接改变属性值，这与用VBA语句改变属性具有同样的效果；还可以通过“本地”窗口快速浏览某个对象的所有属性。

它清楚地显示了哪些是包含值的属性（在值栏中有值的属性）和哪些是包含对象引用的属性（在旁边有加号的属性）。

通过单击属性的值看它能否改变，能很容易地发现具有值的属性是不是只读的。

“立即”窗口：在程序调试中，有时需要给某一变量指定一个新值，或输出显示某些变量的值，对此使用“立即”窗口最为方便。

在“立即”窗口，可以输入任何语句并立即执行它。

例如，要查看活动工作簿中所有工作表的名称，则可在“立即”窗口中键入语句For Each x in Workskeets: ?:Next x。

通常，在“立即”窗口中，一条语句占一行，当多条语句排列在一行上时，要用冒号将其分开。

并且在“立即”窗口中大都使用简短、无意义的变量名，这并不影响语句的执行。

“监视”窗口：在执行宏前，或进入中断模式后，打开“监视”窗口，添加监视表达式以便观察关键的测试变量或表达式随宏执行的变化情况。

在“监视”窗口中添加监视表达式的方法是：使用鼠标选中监视表达式，再单击“调试”菜单上的“添加监视”或“快速监视”命令。

要移去监视的变量，只需单击该变量，再按Del键。

3. 错误处理
当发生实时错误时，VBA一般会显示一个错误信息对话框，进入中断模式。

对于这样的错误，在宏设计中可以采用程序加以控制、监测错误，这种方法
称为“错误捕获”。

它可检测出错误并控制程序的流向。

设置忽略错误（容错处理）
语句1：On Error Resume Next
表示：若发生错误，则忽略它，跳到下一条语句继续执行。

语句2：On Error GoTo 行号（或标号）
表示：若运行有错，则跳到标号指定位置，转去执行错误处理例程。

获取错误信息
在宏执行过程中，可以通过专用调试对象Err的属性值来了解是否发生实时错误以及发生了什么样的错误。

若Err.Number值为0，则表明没有产生错误，反之有错误。

下面通过两个例子说明如何使用错误捕获技术。

例1，假设有一学生档案工作簿StudentBook，其中已有若干学生档案工作表Student1
Student2…以及其它一些工作表。

现需要建立一个新的Student学生档案工作表，但又不想删除已有的Student工作表，如同Excel增加新工作表一样，只是将工作表名称的后缀加1。

则实现这一功能的VBA宏程序如下所示：Sub MakeNextStudent( )
Dim Sheet As Worksheet
Dim Base As String
Dim Suffix As Integer
Set Sheet = WorkSheets.Add
Base = “Student”
Suffix = 1
On Error Resume Next
= Base & Suffix
Do Until Err.number = 0
Err.Clear
Suffix = Suffix + 1
= Base & Suffix
Loop
End Sub
MakeNextStudent宏的执行过程是：先建立一个新工作表，再试着以Student 为基本名、1为后缀构成的名称给新工作表命名。

On Error Resume Next
语句的作用是：若已有同名工作表存在，Excel不能给新工作表命名时，Visual Baisc并不终止所执行的程序，而是自动给Err对象的Number属性赋值，设置出错信息代码，执行Do Until循环。

Do Until循环首先检查命名是否成功，若不成功，则增加后缀值，再试着重新命名，再检查…直到没有产生错误（即重新命名成功Err.Number=0），才结束循环。

Do语句后面的Err.Clear 语句的作用是将出错信息代码重新置为0，让Visual Baisc忘记曾经发生的错误。

例2，下面宏的功能是：当试图删除打开的文件时，错误处理例程先调用MsgBox函数提示用户文件正在使用，让用户确认是否要删除该文件，再作相应的处理。

Sub KillFile( )
On Error GoTo KillFile_Err
Open "MyFile" For Output as #1
Kill "MyFile"
Exit Sub
KillFile_Err:
myCheck = MsgBox("MyFile文件正在使用，是否要删除？"，vbYesNo)
If myCheck = vbYes Then
Close #1
Kill "MyFile"
End If
End Sub
综上所述，VBA为程序的调试、查错、纠错以及错误处理提供了方便的工具和方法，是一个优秀的程序设计环境。

1.4 自编函数示例
下面，我将自编的“新编测绘、工程、科学计算通用函数”作为示例公诸于下，供搞测绘、工程、科学计算的朋友们使用参考。

朋友们可依据自身的需求进行取舍、续编下去。

*********************************************************************
' 新编测绘、工程、科学计算函数
' A. 常用常数
' 1. 常数
Public Const M_SEC# = 206264.8
Public Const M_DEG# = 57.2957795130823
Public Const M_RAD# = 1.74532925199433E-02
Public Const M_PI# = 3.14159265358979
' B. 角度转换、常用三角函数及反函数
' 1. “°′″ ”角度转换为弧度
Public Function Rad(ByVal angle As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double
Dim ang As Double, sign As Integer
ang = Abs(angle) + 0.0000000000001: sign = Sgn(angle)
A = Int(ang):
B = (ang - A) * 100#:
C = Int(B):
D = (B - C) * 100#
Rad = sign * (A + C / 60# + D / 3600#) * M_RAD
End Function
' 2. 弧度转换为角度“ 度. 分秒”
Public Function Dms(ByVal radian As Double) As Double
Dim A As Double, B As Double, C As Double, D As Double, e As Double Dim ang As Double, sign As Integer
ang = Abs(radian) + 0.00000000000001: sign = Sgn(radian): A = ang * M_DEG
B = Int(A):
C = (A - B) * 60:
D = Int(C): e = (C - D) * 60
Dms = sign * (B + D / 100# + e / 10000#)
End Function
' 3. 弧度转换为角度“×°×′× ″
Public Function Dfm(ByVal radian As Double) As String
Dim A As Double, B As Double, C As Double, D As Double, e As Double Dim ang As Double, sign As Integer
ang = Abs(radian) + 0.00000000000001: sign = Sgn(radian): A = ang * M_DEG
B = Int(A):
C = (A - B) * 60:
D = Int(C): e = (C - D) * 60
Dfm = Str$(sign * B) & "°" & Str$(D) & "′" & Str$(Round(e, 2)) & "″"
End Function
' C. 常用三角函数及反函数
' 1. 正弦sind（度.分秒）
Public Function sind(ByVal x As Double) As Double
sind = Sin(Rad(x))
End Function
' 2. 余弦cosd（度.分秒）
Public Function cosd(ByVal x As Double) As Double
cosd = Cos(Rad(x))
End Function
' 3. 正切tand（度.分秒）
Public Function tand(ByVal x As Double) As Double
tand = Tan(Rad(x))
End Function
' 4. 余切ctnd（度.分秒）
Public Function ctnd(ByVal x As Double) As Double
ctnd = 1 / Tan(Rad(x) + 0.00000000000001)
End Function
' 5. 反正弦→弧度
Public Function asin(ByVal x As Double) As Double
asin = Atn(x / Sqr(-x * x + 1))
End Function
' 6. 反正弦→（度.分秒）
Public Function asind(ByVal x As Double) As Double
asind = Dms(Atn(x / Sqr(-x * x + 1)))
End Function
' 7. 反余弦→弧度
Public Function acos(ByVal x As Double) As Double
acos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
' 8. 反余弦→（度.分秒）
Public Function acosd(ByVal x As Double) As Double
acosd = Dms(Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1))
End Function
' 9. 反正切→（度.分秒）
Public Function atnd(ByVal x As Double) As Double
atnd = Dms(Atn(x))
End Function
' D. 常用测量、工程计算函数
'………………
' D.25 填方量
Public Function Tfl(ByVal xc1 As Double, ByVal yc1 As Double, ByVal hc1 As Double, ByVal hpa As Double, _
ByVal xc2 As Double, ByVal yc2 As Double, ByVal hc2 As Double, ByVal hpb As Double, ByVal xc3 As Double, _
ByVal yc3 As Double, ByVal hc3 As Double, ByVal hpc As Double) As Double
Dim x1 As Double, y1 As Double, h1 As Double, ha As Double, x2 As Double, y2 As Double, h2 As Double, _
hb As Double, x3 As Double, y3 As Double, h3 As Double, hc As Double Dim xm As Double, ym As Double, hm As Double, xn As Double, yn As Double, hn As Double
Dim tfl1 As Double, tfl2 As Double, tflg As Double
'1
If xc1 = 0 Or xc2 = 0 Or xc3 = 0 Then GoTo js
If (hpa - hc1) >= 0 And (hpb - hc2) >= 0 And (hpc - hc3) >= 0 Then
x1 = xc1: y1 = yc1: h1 = hpa: ha = hc1: x2 = xc2: y2 = yc2: h2 = hpb: hb = hc2: x3 = xc3: y3 = yc3: h3 = hpc: hc = hc3
tflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
'2
ElseIf (hpa - hc1) <= 0 And (hpb - hc2) >= 0 And (hpc - hc3) >= 0 Then
0.000000001))
ym = yc1 + (yc2 - yc1) / (1 + Abs(hpb - hc2) / Abs(hpa - hc1 +
0.000000001))
hm = hc1 + (hc2 - hc1) / (1 + Abs(hpb - hc2) / Abs(hpa - hc1 +
0.000000001))
xn = xc1 + (xc3 - xc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
yn = yc1 + (yc3 - yc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
hn = hc1 + (hc3 - hc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
x1 = xc2: y1 = yc2: h1 = hpb: ha = hc2: x2 = xm: y2 = ym: h2 = hm: hb = hm: x3 = xc3: y3 = yc3: h3 = hpc: hc = hc3
tfl1 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc3: y2 = yc3: h2 = hpc: hb = hc3: x3 = xn: y3 = yn: h3 = hn: hc = hn
tfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
tflg = tfl1 + tfl2
'3
ElseIf (hpa - hc1) <= 0 And (hpb - hc2) <= 0 And (hpc - hc3) >= 0 Then xm = xc3 + (xc1 - xc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
ym = yc3 + (yc1 - yc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
hm = hc3 + (hc1 - hc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
xn = xc3 + (xc2 - xc3) / (1 + Abs(hpb - hc3) / Abs(hpc - hc3 +
0.000000001))
yn = yc3 + (yc2 - yc3) / (1 + Abs(hpb - hc3) / Abs(hpc - hc3 +
0.000000001))
hn = hc3 + (hc2 - hc3) / (1 + Abs(hpb - hc3) / Abs(hpc - hc3 +
0.000000001))
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc3: y2 = yc3: h2 = hpc: hb = hc3: x3 = xn: y3 = yn: h3 = hn: hc = hn
tflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
'4
ElseIf (hpb - hc2) <= 0 And (hpc - hc3) >= 0 And (hpa - hc1) >= 0 Then xm = xc2 + (xc3 - xc2) / (1 + Abs(hpc - hc3) / Abs(hpb - hc2 +
0.000000001))
ym = yc2 + (yc3 - yc2) / (1 + Abs(hpc - hc3) / Abs(hpb - hc2 +
0.000000001))
0.000000001))
xn = xc2 + (xc1 - xc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
yn = yc2 + (yc1 - yc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
hn = hc2 + (hc1 - hc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc3: y2 = yc3: h2 = hpc: hb = hc3: x3 = xn: y3 = yn: h3 = hn: hc = hn
tfl1 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
x1 = xc3: y1 = yc3: h1 = hpc: ha = hc3: x2 = xn: y2 = yn: h2 = hn: hb = hn: x3 = xc1: y3 = yc1: h3 = hpa: hc = hc1
tfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
tflg = tfl1 + tfl2
'5
ElseIf (hpb - hc2) <= 0 And (hpc - hc3) <= 0 And (hpa - hc1) >= 0 Then xm = xc1 + (xc2 - xc1) / (1 + Abs(hpb - hc2) / Abs(hpa - hc1 +
0.000000001))
ym = yc1 + (yc2 - yc1) / (1 + Abs(hpb - hc2) / Abs(hpa - hc1 +
0.000000001))
hm = hc1 + (hc2 - hc1) / (1 + Abs(hpb - hc2) / Abs(hpa - hc1 +
0.000000001))
xn = xc1 + (xc3 - xc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
yn = yc1 + (yc3 - yc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
hn = hc1 + (hc3 - hc1) / (1 + Abs(hpc - hc3) / Abs(hpa - hc1 +
0.000000001))
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc1: y2 = yc1: h2 = hpa: hb = hc1: x3 = xn: y3 = yn: h3 = hn: hc = hn
tflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
'6
ElseIf (hpc - hc3) <= 0 And (hpa - hc1) >= 0 And (hpb - hc2) >= 0 Then xm = xc3 + (xc1 - xc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
ym = yc3 + (yc1 - yc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
hm = hc3 + (hc1 - hc3) / (1 + Abs(hpa - hc1) / Abs(hpc - hc3 +
0.000000001))
xn = xc3 + (xc2 - xc3) / (1 + Abs(hpb - hc2) / Abs(hpc - hc3 +
0.000000001))
0.000000001))
hn = hc3 + (hc2 - hc3) / (1 + Abs(hpb - hc2) / Abs(hpc - hc3 +
0.000000001))
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc1: y2 = yc1: h2 = hpa: hb =
hc1: x3 = xn: y3 = yn: h3 = hn: hc = hn
tfl1 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
x1 = xc1: y1 = yc1: h1 = hpa: ha = hc1: x2 = xn: y2 = yn: h2 = hn: hb = hn: x3 = xc2: y3 = yc2: h3 = hpb: hc = hc2
tfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
tflg = tfl1 + tfl2
'7
ElseIf (hpc - hc3) <= 0 And (hpa - hc1) <= 0 And (hpb - hc2) >= 0 Then
xm = xc2 + (xc3 - xc2) / (1 + Abs(hpc - hc3) / Abs(hpb - hc2 +
0.000000001))
ym = yc2 + (yc3 - yc2) / (1 + Abs(hpc - hc3) / Abs(hpb - hc2 +
0.000000001))
hm = hc2 + (hc3 - hc2) / (1 + Abs(hpc - hc3) / Abs(hpb - hc2 +
0.000000001))
xn = xc2 + (xc1 - xc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
yn = yc2 + (yc1 - yc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
hn = hc2 + (hc1 - hc2) / (1 + Abs(hpa - hc1) / Abs(hpb - hc2 +
0.000000001))
x1 = xm: y1 = ym: h1 = hm: ha = hm: x2 = xc2: y2 = yc2: h2 = hpb: hb =
hc2: x3 = xn: y3 = yn: h3 = hn: hc = hn
tflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)
'8
ElseIf (hpa - hc1) <= 0 And (hpb - hc2) <= 0 And (hpc - hc3) <= 0 Then
tflg = 0
End If
Tfl = Round(tflg, 2)
js:
End Function
…请续编 *************************************************************
打开电子表格“ＶＢ编辑器”，选择“插入”→“模块”，将以上“新编测绘、工程、科学通用函数”代码输入（复制、粘贴）到模块代码编辑窗口中，编译成功后，为模块加个保护：单击“工具”→“VBAProject属性…”→“保护”，选定“查
看时锁定工程”，输入密码，“确定”，退出“ＶＢ编辑器”。

然后，取名“新编测绘、工程、科学通用函数”或您喜欢的名字，并保存为“Microsoft Excel 加载宏”类型。

这样在Excel 里就会增加一项“新编测绘、工程、科学通用函数”加载宏，以后需要用这些函数，就可选择“工具”→“加载宏…”，选中“新编测绘、工程、科学通用函数”，“确定”后，即可在Excel 中像使用系统函数一样使用这些函数了。

不需要的时候勾销“新编测绘、工程、科学通用函数”加载宏项即可。

如果您仔细研究上述自编函数的编程过程和方法，您也就学会了专业函数的编程了。

1.5 系统函数
前面，在自编函数中，我们已经调用了一些Microsoft Excel系统函数，下面我们把电子表格自带的系统函数分类进行整理展示，并对有关测绘、工程、科学计算、以及与编程自动化计算有关的常用函数，以粗体详示，带“*”的函数为Excel和VB通用函数，不带“*”的是Excel函数，供专业朋友们查用参考。

在Visual Basic 中，通过WorksheetFunction 对象可使用Microsoft Excel 工作表函数。

以下Sub 过程使用Min 工作表函数来决定在某个单元格区域中的最小值。

首先，将变量myRange 声明为Range 对象，然后将其设置为Sheet1 上的A1:C10 单元格区域。

指定另一个变量answer 为对myRange 应用Min 函数的结果。

最后，answer 的值就被显示在消息框中。

Sub UseFunction()
Dim myRange As Range
Set myRange = Worksheets("Sheet1").Range("A1:C10")
answer = Application.WorksheetFunction.Min(myRange)
MsgBox answer
End Sub
此外，还有许多VB编程函数，朋友们可以根据需要查看VB函数的帮助信息。

一，数据库和数据清单管理函数
Microsoft Excel 中包含了一些工作表函数，用于对存储在数据清单或数据库中的数据进行分析，这些函数统称为Dfunctions，每个函数均有三个参数：database、field 和criteria。

这些参数指向函数所使用的工作表区域。

*DAVERAGE 返回选定数据库项的平均值
*DCOUNT 计算数据库中包含数字的单元格个数
*DCOUNTA 计算数据库中非空单元格的个数
*DGET 从数据库中提取满足指定条件的单个记录
*DMAX 返回选定数据库项中的最大值
*DMIN 返回选定数据库项中的最小值
*DPRODUCT 将数据库中满足条件的记录的特定字段中的数值相乘
*DSTDEV 基于选定数据库项中的单个样本估算标准偏差
*DSTDEVP 基于选定数据库项中的样本总体计算标准偏差
*DSUM 对数据库中满足条件的记录的字段列中的数字求和
*DVAR 基于选定的数据库项的单个样本估算方差
*DVARP 基于选定的数据库项的样本总体估算方差
GETPIVOTDATA 返回存储于数据透视表中的数据
二，日期和时间函数
DATE 返回特定日期的序列号
DATEVALUE 将文本格式的日期转换为序列号
DAY 将序列号转换为月份中的日
*DAYS360 按每年360 天计算两个日期之间的天数
EDATE 返回在开始日期之前或之后指定月数的日期的序列号EOMONTH 返回指定月数之前或之后某月的最后一天的序列号
HOUR 将序列号转换为小时
MINUTE 将序列号转换为分钟
MONTH 将序列号转换为月
NETWORKDAYS 返回两个日期之间的全部工作日数
NOW()返回当前日期和时间的序列号
SECOND 将序列号转换为秒
TIME 返回特定时间的序列号
TIMEVALUE 将文本格式的时间转换为序列号
TODAY 返回今天的日期。

如：今天是2006年3月31日，则，
[F2]=TODAY()，Ｆ2单元格将依据单元格的格式显示2006年3月31日或2006-3-31。

*WEEKDAY 将序列号转换为星期几
WEEKNUM 将序列号转换为一年中相应的周数
WORKDAY 返回指定工作日数之前或之后某日期的序列号
YEAR 将序列号转换为年
YEARFRAC 返回代表开始日期和结束日期之间总天数的以年为单位的分数
三，工程函数
BESSELI 返回经过修改的贝塞尔函数In(x)
BESSELJ 返回贝塞尔函数Jn(x)
BESSELK 返回经过修改的贝塞尔函数Kn(x)
BESSELY 返回贝塞尔函数Yn(x)
BIN2DEC 将二进制数转换为十进制数
BIN2HEX 将二进制数转换为十六进制数
BIN2OCT 将二进制数转换为八进制数
COMPLEX 将实系数和虚系数转换为复数
CONVERT 将数字从一种度量系统转换为另一种度量系统
DEC2BIN 将十进制数转换为二进制数
DEC2HEX 将十进制数转换为十六进制数
DEC2OCT 将十进制数转换为八进制数。