第一章 电子表格专业函数编程.doc

第一章电子表格专业函数编程1.1 如何把“度.分秒”角度变成弧度？在Excel 中，自带了大量的商务、办公标准函数，唯独没有把“度.分秒”角度变成“弧度”和将“弧度”转换为“度.分秒”或“ ”这样的专业计算函数。在测绘、工程、科学计算中，这经常是一个无法回避的问题。怎么办？打开Excel，选择“工具”“宏”“Visual Basic编辑器”“帮助”“Visual Basic语言参考”“语句”“A-L” “Function”，就可以详细看到编写函数“Function”的相关语法：Public | Private | Friend Static Function name (arglist) As typestatementsname = expressionExit Function statementsname = expressionEnd FunctionFunction 语句的语法包含下面部分：部分描述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”值的情况，这样，程序运行时，当这个变量等于“0”时，就会出错。在实时错误中，有些是Visual Baisc能指出错误所在的，有些是程序员能预料的、能让Visual Baisc自动处理的。在程序调试过程中，VBA提供了各种强有力的调试工具来查找和纠正错误。1. 使用中断模式中断模式是指在程序执行过程中被暂时停止。此时所有变量、属性、表达式之值都维持在最新的状态，可以进行分析、测试或是重新设置等，以便检错纠错。进入中断模式的方法有以下几种：单步执行：按F8键。单步执行类似在下一条语句上设置断点，执行当前语句并清除断点。单步执行时，可观察每条语句的执行情况。设置断点：单击要设置断点的语句行的左侧边界区域；或从“调试”菜单中选“切换断点”命令。相应语句行左侧出现一个深红色圆点，该行也以深红色背景显示。设置临时断点（即只用一次的断点）：单击要设置断点的语句行，从“调试”菜单中选“运行到光标处”命令。在宏程序中需中断处加入Stop语句；在宏执行时，按Ctrl+Break键；在宏执行时，产生实时错误，程序自动进入中断模式。符合监视表达式的条件与设定，程序进入中断模式。2. 利用各种窗口在VBA程序设计环境中，提供了“代码”窗口、“本地”窗口、“立即”窗口、“监视”窗口、“工程”窗口、“属性”窗口和“对象浏览器”窗口等7个窗口。从“查看”菜单中选择相应的命令可以显示出这些窗口。其中，“代码”窗口、“本地”窗口、“立即”窗口、“监视”窗口是调试程序的得力工具。“代码”窗口：在中断模式下运行宏时，可以通过“代码”窗口来仔细地观察宏的执行过程，也可以通过将鼠标指针指向某变量来检测变量的值。此时，在“代码”窗口内，准备执行的语句以黄色高亮方式显示，在其左边有一个黄色箭头。“本地”窗口：在运行一个宏时，可以通过“本地”窗口观察宏程序所使用的变量、表达式、对象的变化来寻找程序错误；也可在“本地”窗口直接改变属性值，这与用VBA语句改变属性具有同样的效果；还可以通过“本地”窗口快速浏览某个对象的所有属性。它清楚地显示了哪些是包含值的属性（在值栏中有值的属性）和哪些是包含对象引用的属性（在旁边有加号的属性）。通过单击属性的值看它能否改变，能很容易地发现具有值的属性是不是只读的。“立即”窗口：在程序调试中，有时需要给某一变量指定一个新值，或输出显示某些变量的值，对此使用“立即”窗口最为方便。在“立即”窗口，可以输入任何语句并立即执行它。例如，要查看活动工作簿中所有工作表的名称，则可在“立即”窗口中键入语句For Each x in Workskeets: ?x.Name:Next x。通常，在“立即”窗口中，一条语句占一行，当多条语句排列在一行上时，要用冒号将其分开。并且在“立即”窗口中大都使用简短、无意义的变量名，这并不影响语句的执行。“监视”窗口：在执行宏前，或进入中断模式后，打开“监视”窗口，添加监视表达式以便观察关键的测试变量或表达式随宏执行的变化情况。在“监视”窗口中添加监视表达式的方法是：使用鼠标选中监视表达式，再单击“调试”菜单上的“添加监视”或“快速监视”命令。要移去监视的变量，只需单击该变量，再按Del键。 3. 错误处理当发生实时错误时，VBA一般会显示一个错误信息对话框，进入中断模式。对于这样的错误，在宏设计中可以采用程序加以控制、监测错误，这种方法称为“错误捕获”。它可检测出错误并控制程序的流向。设置忽略错误（容错处理）语句1：On Error Resume Next表示：若发生错误，则忽略它，跳到下一条语句继续执行。语句2：On Error GoTo 行号（或标号）表示：若运行有错，则跳到标号指定位置，转去执行错误处理例程。获取错误信息在宏执行过程中，可以通过专用调试对象Err的属性值来了解是否发生实时错误以及发生了什么样的错误。若Err.Number值为0，则表明没有产生错误，反之有错误。下面通过两个例子说明如何使用错误捕获技术。例1，假设有一学生档案工作簿StudentBook，其中已有若干学生档案工作表Student1Student2以及其它一些工作表。现需要建立一个新的Student学生档案工作表，但又不想删除已有的Student工作表，如同Excel增加新工作表一样，只是将工作表名称的后缀加1。则实现这一功能的VBA宏程序如下所示：Sub MakeNextStudent( )Dim Sheet As WorksheetDim Base As StringDim Suffix As IntegerSet Sheet = WorkSheets.AddBase = “Student”Suffix = 1On Error Resume NextSheet.Name = Base & SuffixDo Until Err.number = 0Err.ClearSuffix = Suffix + 1Sheet.Name = Base & SuffixLoopEnd SubMakeNextStudent宏的执行过程是：先建立一个新工作表，再试着以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_ErrOpen MyFile For Output as #1Kill MyFileExit SubKillFile_Err:myCheck = MsgBox(MyFile文件正在使用，是否要删除？， vbYesNo)If myCheck = vbYes ThenClose #1Kill MyFileEnd IfEnd Sub综上所述，VBA为程序的调试、查错、纠错以及错误处理提供了方便的工具和方法，是一个优秀的程序设计环境。 1.4自编函数示例下面，我将自编的“新编测绘、工程、科学计算通用函数”作为示例公诸于下，供搞测绘、工程、科学计算的朋友们使用参考。朋友们可依据自身的需求进行取舍、续编下去。*新编测绘、工程、科学计算函数 A. 常用常数 1. 常数Public Const M_SEC# = 206264.8Public Const M_DEG# = 57.2957795130823Public Const M_RAD# = 1.74532925199433E-02Public Const M_PI# = 3.14159265358979 B. 角度转换、常用三角函数及反函数 1. “ ”角度转换为弧度Public Function Rad(ByVal angle As Double) As DoubleDim A As Double, B As Double, C As Double, D As DoubleDim ang As Double, sign As Integerang = 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_RADEnd Function 2. 弧度转换为角度“ 度. 分 秒 ”Public Function Dms(ByVal radian As Double) As DoubleDim A As Double, B As Double, C As Double, D As Double, e As DoubleDim ang As Double, sign As Integerang = Abs(radian) + 0.00000000000001: sign = Sgn(radian): A = ang * M_DEGB = Int(A): C = (A - B) * 60: D = Int(C): e = (C - D) * 60Dms = sign * (B + D / 100# + e / 10000#)End Function 3. 弧度转换为角度“ Public Function Dfm(ByVal radian As Double) As StringDim A As Double, B As Double, C As Double, D As Double, e As DoubleDim ang As Double, sign As Integerang = Abs(radian) + 0.00000000000001: sign = Sgn(radian): A = ang * M_DEGB = Int(A): C = (A - B) * 60: D = Int(C): e = (C - D) * 60Dfm = Str$(sign * B) & & Str$(D) & & Str$(Round(e, 2) & End Function C. 常用三角函数及反函数 1. 正弦sind（度.分秒）Public Function sind(ByVal x As Double) As Doublesind = Sin(Rad(x)End Function 2. 余弦cosd（度.分秒）Public Function cosd(ByVal x As Double) As Doublecosd = Cos(Rad(x)End Function 3. 正切tand（度.分秒）Public Function tand(ByVal x As Double) As Doubletand = Tan(Rad(x)End Function 4. 余切ctnd（度.分秒）Public Function ctnd(ByVal x As Double) As Doublectnd = 1 / Tan(Rad(x) + 0.00000000000001)End Function 5. 反正弦弧度Public Function asin(ByVal x As Double) As Doubleasin = Atn(x / Sqr(-x * x + 1)End Function 6. 反正弦（度.分秒）Public Function asind(ByVal x As Double) As Doubleasind = Dms(Atn(x / Sqr(-x * x + 1)End Function 7. 反余弦弧度Public Function acos(ByVal x As Double) As Doubleacos = Atn(-x / Sqr(-x * x + 1) + 2 * Atn(1)End Function 8. 反余弦（度.分秒）Public Function acosd(ByVal x As Double) As Doubleacosd = Dms(Atn(-x / Sqr(-x * x + 1) + 2 * Atn(1)End Function 9. 反正切（度.分秒）Public Function atnd(ByVal x As Double) As Doubleatnd = 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 DoubleDim 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 DoubleDim xm As Double, ym As Double, hm As Double, xn As Double, yn As Double, hn As DoubleDim tfl1 As Double, tfl2 As Double, tflg As Double1If xc1 = 0 Or xc2 = 0 Or xc3 = 0 Then GoTo jsIf (hpa - hc1) = 0 And (hpb - hc2) = 0 And (hpc - hc3) = 0 Thenx1 = xc1: y1 = yc1: h1 = hpa: ha = hc1: x2 = xc2: y2 = yc2: h2 = hpb: hb = hc2: x3 = xc3: y3 = yc3: h3 = hpc: hc = hc3tflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)2ElseIf (hpa - hc1) = 0 And (hpc - hc3) = 0 Thenxm = 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 = xc2: y1 = yc2: h1 = hpb: ha = hc2: x2 = xm: y2 = ym: h2 = hm: hb = hm: x3 = xc3: y3 = yc3: h3 = hpc: hc = hc3tfl1 = 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 = hntfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)tflg = tfl1 + tfl23ElseIf (hpa - hc1) = 0 And (hpb - hc2) = 0 Thenxm = 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 = hntflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)4ElseIf (hpb - hc2) = 0 And (hpa - hc1) = 0 Thenxm = 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 = xc3: y2 = yc3: h2 = hpc: hb = hc3: x3 = xn: y3 = yn: h3 = hn: hc = hntfl1 = 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 = hc1tfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)tflg = tfl1 + tfl25ElseIf (hpb - hc2) = 0 And (hpc - hc3) = 0 Thenxm = 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 = hntflg = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)6ElseIf (hpc - hc3) = 0 And (hpb - hc2) = 0 Thenxm = 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)yn = yc3 + (yc2 - yc3) / (1 + Abs(hpb - hc2) / Abs(hpc - hc3 + 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 = hntfl1 = 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 = hc2tfl2 = Zsjjzv(x1, y1, h1, ha, x2, y2, h2, hb, x3, y3, h3, hc)tflg = tfl1 + tfl27ElseIf (hpc - hc3) = 0 And (hpa - hc1) = 0 Th