江西二级建筑资质转让:Excel VBA] 认识VBA过程及开发自定义函数

举报
罗刚君

荣誉版主
终身隐身奖

ET图书作者

串个门
加好友
打招呼
发消息
来自 悠ｅ派 [报名]
3楼
发表于 2011-7-3 22:01:13 |只看该作者
本帖最后由 罗刚君 于 2011-7-3 23:50 编辑
2　编写Sub过程
本节开始了解关于Sub过程的基本概念，以及编写简单的Sub过程。
2.1  Sub过程的语法解析
Sub过程即利用Sub语句声明的过程。所以宏录制器产生的过程全是Sub过程，无法通过录制宏产生Function过程或者属性过程。
Sub语句声明过程的语法如下：
Private | Public | Friend] [Static] Sub name [(arglist)]
[statements]
[Exit Sub]
[statements]
End Sub
其中各参数的详细功能如表1所示。
表1　Sub语句参数详解
参数部分        功能解释
Public        可选的。表示所有模块的所有其他过程都可访问这个 Sub 过程。 如果在包含 Option Private 的模块中使用，则这个过程在该工程外是不可使用的
Private        可选的。表示只有在包含其声明的模块中的其他过程可以访问该 Sub 过程
Friend        可选的。只能在类模块中使用。表示该 Sub 过程在整个工程中都是可见的，但对对象实例的控制者是不可见的
Static        可选的。表示在调用之间保留 Sub 过程的局部变量的值。Static 属性对在 Sub 外声明的变量不会产生影响，即使过程中也使用了这些变量
name        必需的。Sub 的名称；遵循标准的变量命名约定
arglist        可选的。代表在调用时要传递给 Sub 过程的参数的变量列表。多个变量则用逗号隔开
statements        可选的。Sub 过程中所执行的任何语句组
Sub过程与所有变量一样，也区分公有和私有，而在说法上稍有区别。过程分模块级过程和工程级过程。
1. 模块级过程
模块级过程即只能在当前模块调用的过程，它的特征有三个：
（1）声明Sub过程前使用Private；
（2）只有当前过程可以调用，例如在“模块1”中有以下代码：
Private Sub 过程一()
MsgBox 123
End Sub
Private Sub 过程二()
Call 过程一
End Sub
执行过程二时可以调用过程一，但如果过程二存放于“模块2”中，则将弹出“子过程未定义”的错误提示。
（3）不出现在“宏”对话框中，即使用快捷键【Alt+F8】所打开的对话框中无法查看到当前过程的名称列表。如果是Function过程，则无法在函数向导中查看到函数名。
提示:所有事件的代码都是过程级的，默认状态下只能在当前过程可以调用。
2. 工程级过程
工程级过程是指在当前工程中任意地方都可以随意调用的过程。它的特征刚好与模块级过程相反：在“Sub”语句前置标识符“Public”、非当前过程可以调用，可以出现在“宏”对话框中。
如果一个过程没有使用“Public”和“Private”标识，则默认为公有过程，任何模块或者窗体中都可以调用。
Sub过程也支持参数，其参数的用法与Function过程的参数用法一致，本小节不详述，请参阅第4节。
3. 中途退出程序的多种方法与分别
Sub过程可以在程序中间任意位置退出程序，通常是设定若干个条件。当满足条件时使用“Exit Sub”来退出程序。当程序退出后，后面的代码不再执行。
也可以使用“End”来退出程序。“End”和“Exit Sub”在使用中有相同处，也有明显的差别。相同处是都可以中途终止程序的运行，不同处则有以下两点。
（1）是否释放公有变量
从以下三段代码可以体现“End”和“Exit Sub”的差异：
Dim x As Long
Sub A()
x = 888
Exit Sub
End Sub
Sub B()
x = 888
End
End Sub
Sub C()
MsgBox x
End Sub
代码中X是公有变量，当执行过程A后执行过程C，那么变量X的值为888，表示X变量的值在过程中并没有释放，“Exit Sub”仅仅退出程序执行，公有变量的值保持不变。
如果执行过程Ｂ再执行过程Ｃ，那么Ｘ的值则为０，说明在过程Ｂ中的“End”已经释放变量X的值。
（2）是否终止所有程序
仍然用三个过程来演示“End”和“Exit Sub”的差异：
Sub A()
Call B
MsgBox "终止"
End Sub
Sub B()
Exit Sub
End Sub
Sub C()
End
End Sub
执行程序A的结果是弹出对话框“终止”，而将过程A中的“Call B”修改为“Call C”，那么什么反应也没有。也就是“Exit Sub”是退出它所在的程序，而“End”则中止所有程序，包括调用它的程序。如果在窗体代码中，“Exit Sub”仅仅退出事件，而“End”则退出事件后关掉窗体，窗体中声明的所有变量全部释放。
2.2  Sub过程的执行流程
如果录用宏并执行宏，可以看出宏代码的执行流程永远是从上到下。可以使用调试功能来查看流程。例如执行以下代码：
Sub 设置A1单元格()
Range("A1").Select
Range("A1") = "中华人民共和国"
Range("A1").Interior.Color = 65535
Range("A1").Font.ColorIndex = 3
Range("A1").Borders.LineStyle = xlContinuous
Range("A1").Font.Name = "黑体"
Range("A1").Font.Size = 20
Range("A1").EntireColumn.AutoFit
End Sub
将VBE窗口缩小，使自己能同时看到代码及A1单元格的情况下再按下快捷键【F8】，从而进入逐句调试阶段。
注意:在VBE中使用【F8】键表示调试代码语句，每按一次【F8】键即执行一句，忽略变量与常量的声明语句，直到“Exit Sub”或者“End”、“End Sub”为止。在编写代码时非常有用，可以借助它检查代码的准确性，同时也可以查看程序间的跳转是否正常（当有标签设置和嵌套调用的时候）。
当按下调试键【F8】时，当前执行的语法呈黄色显示，再次按下【F8】键时，则下一句呈黄色显示，而操作对象A1则对应产生变化。图7中已执行到第四句，所以A2单元格同步后的状态就是录入“中华人民共和国”后并设置了背景色为黄色。
图7  逐步执行代码
当继续通过【F8】键执行完成的代码后，可以得出结论：所有录制的宏和未特别指定程序跳转的VBA代码总是按照从上至下的流程逐句执行。
那么是否有例外呢？通常在以下三种情况会有例外。
1. 使用冒号使一行执行多句代码
VBA中允许借助冒号将多句代码写在同一行执行。对同行中的代码按从左向右的顺序执行。例如：
Sub 设置A1单元格()
Range("A1") = "中华人民共和国": Range("A1").Interior.Color = 65535
Range("A1").Font.ColorIndex = 3: Range("A1").Font.Size = 20
Range("A1").EntireColumn.AutoFit
End Sub
以上代码在借助冒号将四行代码缩至两行，但执行过程仍然为四步。对于同行中有多句代码时，按从左向右的顺序执行。
那么读者一定可以想到，使用冒号和不使用冒号的执行结果岂不是完全一致？仅仅改变了行数？
答案是“有时一致，有时不一致”。如果以上的代码按如下方式编写，那么结果完全一致：
Sub 设置A1单元格()
Range("A1") = "中华人民共和国"
Range("A1").Interior.Color = 65535
Range("A1").Font.ColorIndex = 3
Range("A1").Font.Size = 20
Range("A1").EntireColumn.AutoFit
End Sub
而在下面的代码中，使用冒号后却可以得到完全不同的结果：
Sub 判断是否及格1()
IF [B2] >= 60 Then [C3] = "及格": Exit Sub
IF [B3] >= 60 Then [C3] = "及格"
End Sub
Sub 判断是否及格2()
IF [B2] >= 60 Then [C3] = "及格"
Exit Sub
IF [B3] >= 60 Then [C3] = "及格"
End Sub
假设工作表中有图8所示数据，执行过程“判断是否及格1”时，C3单元格将出现“及格”；而执行过程“判断是否及格2”时则无任何反应。也就是说“Exit Sub”语句与IF同行时，只有单元格B2的值大于或等于60，“Exit Sub”语句才会执行。在本例中不符合条件，那么没有退出程序，可以继续执行其后的代码。而“Exit Sub”语句单独占据一行时，不管单元格B2是否符合条件，“Exit Sub”都会执行，从而退出程序，不再对B3的值进行判断。
图8 数据
2. 使用标签改变执行流程
VBA可以在代码中设置一个或者多个标签，然后让程序在满足某条件时跳转到标签处，从而改变过程执行流程。
标签的规则是：
*可以是标点符号以外的字符组合
* 以冒号（:）结尾
*与大小写无关
*必须位于一行的最左端
*配合GoTo使用
例如，建立一个名为“总表”的工作表，代码如下：
Sub 新建总表()
For i = 1 To Sheets.Count
IF Sheets(i).Name = "总表" Then GoTo err
Next i
Sheets.Add
ActiveSheet.Name = "总表"
End
err:
MsgBox "已经存在总表"
End Sub
以上代码首先利用For循环逐一检查工作表的名字，如果某个工作表的名字等于“总表”则执行标签“Err”之后的代码，否则继续执行For循环，直到循环完成并新建一个工作表、命名为“总表”。
使用标签完成当前程序间的跳转时需要注意两点：
（1）标签名后面必须带有冒号。
（2）在标签之前根据需要，及时退出程序。
在本例中，按照设计意图，只要工作簿中存在“总表”则执行标签“Err”之后的语句，反之不执行。所以标签之前必须加入“End”或者“Exit Sub”来退出程序，否则任何情况下Err后的语句都会被执行。
在一个过程中还可以定义多个标签。例如：
Sub 新建总表()
MsgBox ActiveWorkbook.ProtectWindows
IF ActiveWorkbook.ProtectWindows = true Then GoTo 已加密
For i = 1 To Sheets.Count
IF Sheets(i).Name = "总表" Then GoTo 已存在
Next i
Sheets.Add
ActiveSheet.Name = "总表"
End
已存在:
MsgBox "已经存在总表"
End
已加密:
MsgBox "当前工作簿窗口已锁定，无法建立新表"
End Sub
在此过程中，首先判断当前工作表的窗口是否锁定，如果锁定则执行“已加密”标签后的语句；然后再检查是否存在“总表”，当有“总表”时执行“已存在”标签后的语句。本例中两个标签没有顺序上的差异，谁前谁后不影响代码的结果。
3. Sub过程的嵌套调用方式
过程与过程之间是可以相互调用的，从而使代码的执行流程改变。通过VBA代码调用Sub子过程主要有两种方式。
**Call语句**
Call语句的功能是将一个过程的控制权转移到另一个过程。
它的语法为：[Call] name [argumentlist]，即Call 过程名 参数。
其中Call是可选的，即在其他过程调用过程一时可以有以下两种形式：
Sub 过程一()
MsgBox "你好！"
End Sub
Private Sub 过程二()
过程一
End Sub
Private Sub 过程三()
Call 过程一
End Sub
过程二和过程三都是合法的过程调用。
**Run方法**
Run方法可以运行一个宏或者调用一个函数。该方法可用于运行一个用 Visual Basic 或 Excel 宏语言编写的宏或者运行DLL或XLL中的函数。实例如下：
Sub 过程四()
Application.Run "过程一"
End Sub
其中“Application.Run”也可以简写为“Run”。
2.3  过程的递归
所有过程都是可以递归的，即可以调用自己来完成任务。
实际工作中需要调用过程本身的实例极少，通常进入递归都是编码有问题而误入递归状态，结果耗尽系统资源。
在某些情况下也可以故意调用自己来完成任务。例如下面2例。
1. 按条件新建工作表
Sub 建立10个表()
IF Sheets.Count >= 10 Then Exit Sub
Sheets.Add , Sheets(Sheets.Count), 1
Call 建立10个表
End Sub
以上代码中，首先利用IF查找并检测当前工作簿的工作表数量，如果大于或等于10则退出程序，否则在最后位置新建一个工作表，最后再调用自身继续执行，直到满足条件“大于或等于10”为止。
因代码中人为设置了退出递归的条件，所以这类递归不会造成程序崩溃，资源耗尽。如果将代码中的“IF Sheets.Count >= 10 Then Exit Sub”删除，那么程序循环执行的结果就是电脑死机，除非中途人工中断程序执行：使用快捷键【Ctrl+Break】。
2. 设计时钟
Sub 时间()
[a1] = WorksheetFunction.Text(Now(), "hh:mm:ss")
Application.OnTime Now() + TimeValue("00:00:01"), "时间"
End Sub
Sub 终止()
Application.OnTime Now() + TimeValue("00:00:01"), "时间", , false
End Sub
以上代码实现的效果是在单元格显示当前时间，包括时、分、秒，且每秒钟更新一次。通过递归方式让程序每秒钟执行一次实现时钟的效果，同时再利用另一个过程来随时退出递归。当然也可以用快捷键【Ctrl+Break】。
2.4  Sub过程实例演示
为了更好地理解Sub过程，通过两个示例来展示。
1. 统计选区信息：不带参数的Sub过程
要求：对任意选区进行单元格个数、数值个数、非空单元格个数、空白单元格个数及选区之和统计。
代码如下：
Sub 选区统计()
Dim msg As String
msg = "单元格个数：" & Selection.Count & Chr(10)
msg = msg & "数字个数：" & WorksheetFunction.Count(Selection) & Chr(10)
msg = msg & "非空单元格：" & WorksheetFunction.CountA(Selection) & Chr(10)
msg = msg & "空白单元格个数：" & WorksheetFunction.CountBlank(Selection) & Chr(10)
msg = msg & "选区之和：" & WorksheetFunction.Sum(Selection)
MsgBox msg, 64, "选区统计"
End Sub
假设工作表中存在图9所示数据，选择A1:D9区域后利用快捷键【Alt+F8】执行“选区统计”过程，其统计结果如图10所示。
图9　工作表数据
图10　选区统计结果
2. 将单元格数据转换为首字母大写：带有参数的Sub过程
要求：在工作表中选择任意一个带英文的单元格时，将其转换为每个单词首字母大写。
（1）插入模块1，并录入以下代码：
Sub 转换(Target)
Selection(1) = StrConv(Target, vbProperCase)
End Sub
（2）双击工程资源管理器中的“Sheet1”，进入工作表代码窗口后录入代码：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call 转换(Target(1))
End Sub
（3）返回工作表“Sheet1”，单击任意单元格，如果存在英文单词，则每个单词首字母大写，否则保持为变。如单元格中有句子“You are do it”，那么单击该单元格后将被转换为“You Are Do It”。
附件: 你需要登录才可以下载或查看附件。没有帐号？轻松注册
站内采录编号: 151004
举报
罗刚君

荣誉版主
终身隐身奖

ET图书作者

串个门
加好友
打招呼
发消息
来自 悠ｅ派 [报名]
4楼
发表于 2011-7-3 22:30:42 |只看该作者
本帖最后由 罗刚君 于 2011-7-3 23:51 编辑
3　认识Function过程
Function过程即自定义函数，在插件中应用极广。本节介绍关于Function过程的语法及调用方法。
3.1　Function过程的特点
Function过程的功能较Sub过程的应用范围稍小，Function过程仅仅用于返回一个值或者多个数的组合即数组，而Sub过程可以返回值，还可以对引用的对象进行修改。例如，引用单元格A1的值后对单元格A1设置新的格式，或者修改工作表名称等。Function可以获取工作表名称，但无法修改工作表的名称。
Function过程可以不使用参数，类似于工作表函数Rand和Now等，但绝大部分函数是需要一个参数或者多个参数的，最多时可达255个参数。
3.2　Function的语法解析
Function的语法如下：
[Public | Private | Friend] [Static] Function name [(arglist)] [As type]
[statements]
[name = expression]
[Exit Function]
[statements]
[name = expression]
……
End Function
Function语句的各参数详解如表2所示。
表2　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 的返回值
和Sub过程一样，Function过程也有模块级过程和工程级过程之分。Function前置“Public”即为工程级，前置“Private”则为模块级。
Function名称在声明时需要遵循与Sub过程一样的规则。
如果自定义的Function名称与VBA内部名称一致，仍然可以正常执行，只是在代码中调用Excel内部函数时必须声明其对象库。例如：
Function sqr(AA)
sqr = AA ^ (1 / 3)
End Function
Sub test()
MsgBox "VBA.SQR:" & VBA.sqr(27) & Chr(10) & "SQR:" & sqr(27)
End Sub
图11　自定义SQR和内置SQR的分别
执行test过程时的结果如图11所示。
从结果可以得知，在代码使用“VBA.SQR”可以调用VBA自带的SQR功能，而直接使用SQR则调用自定义的SQR函数的功能。
虽然定义函数时允许与内部函数一致，但却不允许与定义的变量或者常量一致，不管这个变量或者常量是本过程私有的还是模块中公有的，否则将产生“发现二义性的名称”的编译错误。
3.3　调用Function过程
Function过程通常以三种方式调用。
（1）在工作表中通过公式调用：像内部函数一样在工作表中使用，也可以与其他函数嵌套。
（2）在VBA代码中被其他过程调用：就像图9对应的那段代码一样在Sub过程调用函数。
（3）递归：Function过程和Sub一样可以实现递归。如果不是刻意地、有计划地进入递归状态，可能会造成资源耗尽或者溢出堆栈空间。例如下面函数的调用：
Function 递归(参数)
递归 = 递归(参数)
End Function
Sub 测试()
MsgBox 递归(1000)
End Sub
将代码录入到模块中后，执行过程“测试”，立即弹出错误提示“溢出堆栈空间”。
为了避免递归造成的错误，甚至程序崩溃，尽量不要调用自身，开发函数、插件时多方面查核是否可能造成循环引用、递归现象。当然，有目的、有条件的递归是可以给工作带来便利的。
另外，谈到函数就不能不说它的“刷新”性能，即在工作表中使用函数时，当在其他区域的数据更新时，当前单元格的函数是否重新运算，专业术语称之为“易失性”。
用户定义的函数是否有易失性可以使用以下语句来控制：
Application.Volatile
该语句的作用是无论何时在工作表的任意单元格中进行计算，函数都必须重新进行计算。即工作表刷新时调用函数再运算一次，从而实现数据更新，使公式结果同步。
附件: 你需要登录才可以下载或查看附件。没有帐号？轻松注册
站内采录编号: 151011
举报
罗刚君

荣誉版主
终身隐身奖

ET图书作者

串个门
加好友
打招呼
发消息
来自 悠ｅ派 [报名]
5楼
发表于 2011-7-3 22:41:40 |只看该作者
本帖最后由 罗刚君 于 2011-7-3 23:02 编辑
4　关于过程的参数
Sub过程和Function过程都可以使用参数。有参数的过程相对于无参数的过程更具灵活性，相当于给了用户更多自定义的空间。
4.1　Sub过程的参数及应用
Sub过程的语法是：
[Private | Public | Friend] [Static] Sub name [(arglist)]
[statements]
[Exit Sub]
[statements]
……
End Sub
其中“(arglist)”即表示它支持可选的参数，可以不用参数，也可以使用参数；可以使用一个参数，也可以使用多个参数。
其中参数(arglist)的具体语法如下：
[Optional] [ByVal | ByRef] [ParamArray] varname[( )] [As type] [= defaultvalue]
表3 Sub过程参数详解
部分
功能详解
Optional
可选的。表示参数不是必需的关键字。如果使用了该选项，则 arglist 中的后续参数都必须是可选的，而且必须都使用 Optional 关键字声明。如果使用了 ParamArray，则任何参数都不能使用 Optional
ByVal
可选的。表示该参数按值传递
ByRef
可选的。表示该参数按地址传递。ByRef 是 Visual Basic 的默认选项
ParamArray
可选的。只用于 arglist 的最后一个参数，指明最后这个参数是一个 Variant 元素的 Optional 数组。使用 ParamArray 关键字可以提供任意数目的参数。ParamArray 关键字不能与 ByVal、ByRef或 Optional 一起使用
varname
必需的。代表参数的变量的名称，遵循标准的变量命名约定
type
可选的。传递给该过程的参数的数据类型，如果没有选择参数 Optional，则可以指定用户定义类型，或对象类型
defaultvalue
可选的。任何常数或常数表达式。只对 Optional 参数合法。如果类型为 Object，则显式的默认值只能是 Nothing
从表中可以看出，如果需要给Sub过程设置一个可选参数，则可以使用关键字Optional来声明，如果需要设置多个可选参数，则可以使用关键字ParamArray来声明参数。
下例即为使用一个参数的Sub过程：
Sub 过程一(msg As String)
IF Len(msg) <> 0 Then MsgBox msg, 64, "友情提示"
End Sub
Private Sub 过程二()
Call 过程一("你好")
End Sub
如果执行过程二，将弹出图12所示对话框。
图12 提示信息
可能看到以上代码时有读者会有疑问，直接在过程二中执行Msgbox不是更简单吗？例如改成以下代码：
Private Sub 过程二()
MsgBox "你好", 64, "友情提示"
End Sub
在本例中确实二合一后更简单，但当有很多过程需要执行类似操作时，则对一个过程进行判断比每个过程都判断一次更简单。例如：
Sub 姓名(name As String)
Dim i As Byte, rng As Range
For i = 1 To Sheets.Count
IF ThisWorkbook.Sheets(i).name = "许可人员列表" Then: GoTo OK
Next i
MsgBox "不存在“许可人员列表”", 64
Exit Sub
OK:
IF Len(name) < 2 Or Len(name) > 4 Then MsgBox "长度只能2到4,请重新录入", 64: Exit Sub
Set rng = ThisWorkbook.Sheets("许可人员列表").Range("a1:a10").Find(name)
IF rng Is Nothing Then MsgBox "你无操作权限" Else MsgBox "你具有操作权限"
End Sub
Sub 确认权限一() ''手工指定姓名
Call 姓名(Application.InputBox("请输入您的姓名", "确认权限", "", , , , , 2))
End Sub
Sub 确认权限二() ''以当前表A1的值进行判断
Call 姓名(ActiveSheet.Range("A1"))
End Sub
Sub 确认权限三() ''以Office安装用户名进行判断
Call 姓名(Application.UserName)
End Sub
以上代码用于判断指定的用户名是否具有操作权限。在工作簿中有一个工作表名为“许可人员列表”，该表中A1:A10存放10个允许操作的人员名单。程序会将用户输入或者指定方式获取的姓名与表A1:A10中允许的姓名进行比较，如果与任何一个一致则提示“你具有操作权限”，否则提示“你无操作权限”。
在过程“确认权限一”、“确认权限二”和“确认权限三”中都可以调用过程“姓名”，只是参数不同。如果不使用过程“姓名(Name)”作过渡的话，那么过程“姓名(Name)”中的所有代码需要在后面三个过程中出现三次，每一个过程都需要对参数进行多次判断及循环，从而使整个工程的代码偏长。
下例再演示具有两个参数但第二个参数是可选参数的Sub过程：
Sub 改名(Sht_Name As String, Optional i As Byte = 1)
Dim j As Byte
For j = 1 To Sheets.Count
IF Sheets(j).name = Sht_Name Then MsgBox "已存在：" & Sht_Name, 64: End
Next j
IF i >= 1 And i <= Sheets.Count Then Sheets(i).name = Sht_Name
End Sub
Private Sub 过程二()
Call 改名("总表", 12)
End Sub
Private Sub 过程三()
Call 改名("汇总表")
End Sub
以上过程用于工作表改名，根据指定的工作表新名称与工作表序号对工作表重命名。
在以上代码中，过程“改名”具有两个参数，第一参数用于指定工作表新名称，第二参数用于指定工作表序号。如果忽略第二参数，则当作1处理。
将三段代码复制到模块中，执行“过程二”。因其第一参数为“总表”，第二参数为2，那么执行结果即工作簿中第二个工作表重命名为“总表”。
而执行“过程三”后，因忽略了第二参数，默认当作1处理，所以结果为第一个工作表重命名为“汇总表”。
4.2　Function过程的参数
Function过程的参数与Sub过程的参数在语法上完全一致，可以使用相同的参数。
但是Function过程只能返回引用对象的某个属性值或者运算结果，无法改变对象的属性、格式等，所以部分带有参数的Sub过程可以直接改用Function实现，而部分却无法实现。
Function和Sub一样可以使用一个或者多个参数，也可以使用可选参数。但不同的是Function过程只能返回值，所以在声明Function过程时，其所有参数可以指定数据类型，Function过程本身也可以指定数据类型。例如：
Function Str(rng as range) as string
Function与Sub过程的另一个区别是Sub过程的参数允许与Sub过程名一致，而Function的参数绝不能与Function过程名一致。例如：
Sub 成绩(成绩)
IF 成绩 >= 60 Then MsgBox "及格" Else MsgBox "不及格"
End Sub
Sub Test()
成绩 (59)
End Sub
执行“Test”过程可以正确判断成绩59分是否及格。但若改用Function过程则一定出错：
Function 成绩(成绩)
IF 成绩 >= 60 Then 成绩 = "及格" Else 成绩 = "不及格"
End Function
Sub Test()
MsgBox 成绩(59)
End Sub
执行过程“Test”后将弹出“当前范围内的声明重复”的编译错误。即使再修改为以下方式仍然报错：
Function 成绩(成绩)
IF 成绩 >= 60 Then MsgBox "及格" Else MsgBox "不及格"
End Function
Sub Test()
Call 成绩 (59)
End Sub
正确的方式是：
Function 成绩(分数)
IF 分数 >= 60 Then 成绩 = "及格" Else 成绩 = "不及格"
End Function
Sub Test()
MsgBox 成绩(59)
End Sub
附件: 你需要登录才可以下载或查看附件。没有帐号？轻松注册
站内采录编号: 151018
举报
罗刚君

荣誉版主
终身隐身奖

ET图书作者

串个门
加好友
打招呼
发消息
来自 悠ｅ派 [报名]
6楼
发表于 2011-7-3 23:03:36 |只看该作者
本帖最后由 罗刚君 于 2011-7-3 23:30 编辑
5开发自定义函数
第4节对自定义函数的基础知识做了详解，本节则进行实例演示，通过带有不同参数的函数定义过程来增进读者的理解与编写功底。
5.1　开发不带参数的Function过程
1. 不随时间变化的时间函数
【要求】：函数需要获取当前系统时间，但却不能随其他单元格的值的改变而更改时间值。
【代码】：
Function Nows()''声明函数
Dim Tim As String''声明一个变量
Tim = Format(Now, "yyyy-mm-dd hh:mm:ss")''获取当前时间,并转换成文本
Nows = Tim''将文本日期赋予函数
End Function
【测试】：
将以上代码录入模块中，然后返回工作表界面。
在工作表中，A列用于存放仓库的进库数量，而B列用于登记进库时间。现需求的是只要A列录入数据，B列则自动产生当前时间，而且这个时间不会因为其他数据的修改而变化。
在B2单元格录入公式：=IF(A2="","",Nows())
将公式向下填充到A100，然后返回A2单元格录入进库数量500，B2则自动出现录入进库数量的时间。过半小时再在A3录入第二次进库的数量800，B3单元格则自动产生第二次进库的时间，且第一次进库时间保持不变……具体效果如图13所示。
提示
代码中的Now是VBA函数，不是工作表函数NOW（），所以不需要带括号，但它们功能相同。
点评
相对于系统自带的工作表函数NOW，Nows函数具有不随时间变化的优点，对于记录进库时间这类工作的应用极广。此外，如果仅仅需要不变的日期，忽略时间，可以不改变代码，而直接在公式中套用Text函数即可，例如：
=TEXT(Nows(),"yyyy-mm-dd")
2. 取当前工作簿名
【要求】：利用函数获取当前工作薄名称，不管工作簿是否保存。
【代码】：
Function 工作簿名()''获取当前工作簿名称
工作簿名 = ActiveWorkbook.Name''ActiveWorkbook即表示当前工作簿
End Function
【测试】：
进入工作表，在单元格录入以下公式即可获取当前工作簿名，如图6.14所示。
=工作簿名()
图13 测试不随时间变化的时间函数
图14 获取工作簿名
提示
未保存的工作簿也具有Name属性，若需要取得路径名，则需要使用FullName属性，不过它需要在保存工作簿后才能取得。
点评
Excel没有获取工作簿名称的函数，利用Cell函数勉强可以完成，不过它有两个缺点：工作簿名包含路径，若工作簿未保存则无法获取名称。本自定义函数不管工作簿是否保存都可以顺利地获取工作簿名，不过未保存的工作簿就没有后缀名。
5.2 开发带有一个参数的Function过程
1. 将人民币金额转换为大写
【要求】：对于财务报表，金额默认为阿拉伯数字，现需将其转换**民币大写形式。
【代码】：
Function 大写(CELL As String) As String ''声明函数名,有一个参数
Dim RMBS As String
IF CELL = "" Or Not IsNumeric(CELL) Then 大写 = "": Exit Function ''如果参数为空或者非数值则返回空白
IF CELL = 0 Then 大写 = "零元整": Exit Function ''如果参数为0则返回"零元整"
''将数值转换成中文大写,并将点替换成"元",将负号替换成"负"
RMBS = Replace(Replace(Application.Text(Round(CELL, 2), "[DBnum2]"), ".", "元"), "-", "负")
''加入角与分,同时将最后的"零"替换成"元整"
RMBS = IIF(Left(Right(RMBS, 3), 1) = "元", Left(RMBS, Len(RMBS) - 1) & "角" & Right(RMBS, 1) & "分", IIF(Left(Right(RMBS, 2), 1) = "元", RMBS & "角", IIF(RMBS = "零", "", RMBS & "元整")))
''将"零元"和"零角"替换成空
RMBS = Replace(Replace(RMBS, "零元", ""), "零角", "")
大写 = RMBS ''将变量的值赋予函数
End Function
提示
（1）IsNumeric用于判断参数是否是数字，非数字是无法转换**民币大写的；
（2）Replace是用于替换的函数，但它和工作表函数Replace有极大的不同，与SUBSTITUTE函数极其相近。
【测试】：
如图15所示工作表中的员工工资需要汇总后以大写金额显示，那么在单元格B7录入以下公式：
=大写(SUM(B2:B6))
点评
Excel自带的Text函数可以实现数字转中文大写，但无法实现人民币大写。借用本函数可以大幅提升财务人员的工作效率。大写函数与Text函数在大写方面的差异见图6-16。
图15 汇总并转换成大写
图16 Text与大写函数之差异
2. 建立工作表目录
【要求】：在工作表中建立当前工作簿的目录，且当单击目录中的工作表名可以跳转到该工作表中。
【代码】：
Function 工作表(Optional 序号) As String''声明函数,有一个参数可选参数
Application.Volatile ''声明为易失性函数
''如果未输入参数,则赋予变量序号为当前表的地址
IF IsMissing(序号) Then 序号 = ActiveSheet.Index
IF 序号 > Sheets.Count Then ''如果参数大于工作表数量
工作表 = ""''返回空
Else''否则
工作表 = Sheets(序号).Name ''取表名
End IF
End Function
提示
（1）IsMissing用于判断函数的可选参数是否已经传递给过程。在本例中如果不指定函数的参数，则默认返回当前工作表的表名；
（2）Index属性则是指工作表在所有工作表中的序号（从左向右数）。
【测试】：
在工作表的A2中录入以下公式，并向下填充，即可完成工作表目录的创建。当鼠标单击任意单元格A3时，将打开名为“工作簿名”的工作表。
=HYPERLINK("#"&工作表(ROW(A2))&"!A1",工作表(ROW(A1)))
图17　创建工作表目录
点评
Excel本身没有获取工作表的函数，虽然依靠调用宏表函数并借助名称可以完成，但公式较长，且必须要借助名称，公式无法在单元格中直接套用。本自定义函数以“Row(a1)”作为参数可以逐一提取工作表名，再配合“HYPERLINK”即可建立链接。
3.关机函数
【要求】：利用函数在指定时间内关闭计算机。
【代码】：
Function 关机(Optional Close_Time As Byte = 10)''声明函数名称,有一个可选参数
关机 = Close_Time''在单元格显示时间
Shell "shutdown -s -t " & Close_Time''在指定的时间内关闭计算机,调用DOS命令
End Function
提示
（1）关机函数的参数使用了Byte数据类型，所以这个时间只能是在0到255秒之间。如果需要更长的时间，可以改用Integer；
（2）Shutdown是一个DOS下的程序，可以用Shell函数来执行。
【测试】：
在工作表任意单元格录入以下公式，那么10秒钟后可以关闭计算机。如果将参数设定为3，则3秒钟后关闭计算机。
=关机()
点评
Excel本身是不具备系统控制能力的，但DOS下很多工具具有系统权限，而VBA的Shell函数恰好可以调用DOS下的所有程序，所以VBA也就获得了对操作系统的部分控制功能。如果需要重启电脑，可以将Shutdown的参数“-S”改为“-R”。
注意：测试此函数会关掉计算机，请在保存所有资料后再行测试。
5.3 开发带有两个参数的Function过程
1. 对带“/”的数据进行合计
【要求】：盘点产品时，部分产品以“双”为单位，部分产品无法配双，则以“左/右”形式出现，现需对这种数据进行汇总，且按需求有时会按“只”计算，有时按“双”计算，公式必须具备通用性及可选性。
【代码】：
Function hesum(rng As Range, Optional 单双 As Byte = 1) ''声明函数,有两个参数,第二个是可选参数
Application.Volatile ''声明为易失性函数
Dim cell As Range, Sum1, Sum2
For Each cell In rng
IF InStr(cell, "/") > 0 Then''如果有“/”
左 = CLng(Left(cell, InStr(cell, "/") - 1))''提取/左边的数据
右 = CLng(Replace(cell, 左 & "/", ""))''提取/右边的数据
Sum1 = Sum1 + (左 + 右) ''将左右相加
Else
sum2 = Sum2 + cell * 2 ''没有“/”则直接乘以2
End IF
Next
hesum = (Sum2 + Sum1) / 单双 ''汇总后除以第二参数
End Function
提示
（1）InStr函数用于在盘点表中查找“/”，如果查找结果大于0，则分别取“/”左、右的数值相加，否则直接取数值本身。
（2）函数的第二参数为可选函数，如果忽略参数，则按“只”为单位计算，即当作1处理。
图18 汇总表盘表数据
【测试】：在如图18所示的工作表中，在B10单元格录入以下公式可以对盘点数进行汇总，合计数以“只”为单位：
=hesum(B3:B9)
如果需要汇总结果以双为单位，则需要将公式改为：
=hesum(B3:B9,2)
【点评】：针对带有“/”的盘点数据，Excel本身不存在可以直接计算的公式，如果用多函数嵌套也可以计算出正确结果，但公式极长，而Hesum函数却简短易懂。内置公式附后：
=SUM(IF(ISNUMBER(FIND("/",B3:B9)),(LEFT(B3:B9,FIND("/",B3:B9)-1)+RIGHT(B3:B9,LEN(B3:B9)-FIND("/",B3:B9)))/2,B3:B9))*2
2. 中国式排名
【要求】：对学生成绩按班级排名、按性别排名，且需按中国式排名。
【代码】：
Function 排名(区域, 成绩) ''声明函数,有两个参数
Application.Volatile ''声明为易失性函数
Dim Dic As Object, rng, i As Integer ''声明变量，包括一个字典对象
Set Dic = CreateObject("scripting.dictionary") ''声明字典对象变量
For Each rng In 区域''遍历区域
''如果变量rng等于成绩则为变量i赋值1,如果变量rng大于成绩,则将rng的值追加到字典中
IF rng = 成绩 Then i = 1 Else IF rng > 成绩 Then Dic(rng * 1) = 1
Next
''如果变量i大于0,即区域中有数据等于成绩,那么排名结果等于字典中的数量加1(字典对象是忽略重复值的)
IF i > 0 Then 排名 = Dic.Count + 1 Else 排名 = "超出范围" ''如果成绩与区域中任何数据都不相等则返回"超出范围"
End Function
提示
（1）CreateObject("scripting.dictionary")用于创建一个字典对象，它的特点是成员不重复。而中国式排名，是需要忽略重复值的。即四人中第一人100分算第一名，两个99分并列第二名，而98分者按第三名计算，而非美式排名中的第四名。所以设计排名函数时需要借助字典这个特性来实现中国式排名。
（2）函数的两个参数都支持手动录入参数，而非仅仅限于单元格引用。
图19 按条件排名
【测试】：
工作表中有如图6.19所示数据，在E2单元录入以下公式：
=排名(IF(B$2:B$10=B2,D$2:D$10),D2)
再在F2单元格录入以下公式：
=排名(IF(C$2:C$10=C2,D$2:D$10),D2)
选择E2:F2单元格，双击单元格的填充柄，将公式填充到最末尾即可完成排名计算。
点评
Excel有一个内置函数Rank用于对成绩排名，但它是美式排名法。而更重要的是它无法实现按条件排序，它的第一参数必须是单元格，这限制了它的功能发挥，例如以下公式Rank是无法运算的：
=rank(3,{1,2,3,4,5})
而本自定义函数是可以使用内存数组作为参数的：
=排名({1,2,3,4,5},3)
5.4开发带有两个可选参数的Function过程
1. 获取可控制大小写的英文列标
【要求】：返回指定单元格的英文列标，且可以控制列标的大小写状态。如果不指定大小写则默认为大写，如果不指定单元格，则默认计算公式所在单元格的列标。
【代码】：
Function col(Optional rng As Range, Optional style As String = "A")''声明函数名称,有两个可选参数
Application.Volatile''声明为易失性函数
''如果第二参数录入A和a以外的任意字符则返回空白
IF style <> "A" And style <> "a" Then col = "": Exit Function
IF rng Is Nothing Then Set rng = Application.ThisCell''如果忽略第一参数则默认取公式所在单元格
''函数结果等于Cells(1, rng)的地址去除1之后所对应的字母。然后根据第二参数进行大小写控制
col = StrConv(Replace(Cells(1, rng.Column).Address(0, 0), 1, ""), IIF(style = "A", vbUpperCase, vbLowerCase))
End Function
提示
（1）函数中非对象变量被忽略时，可以用IsMissing来判断，但本例中第一参数是单元格对象，所以只对用Nothing来判断，且在赋值时必须用Set语句。
（2）Address属性的两个参数使用0时可以将地址转换成相对引用，这有利于获取列标。
【测试】：
在工作表中录入以下公式测试Col函数：
=Col(D2,"A")——结果为D，第二参数大写则结果也大写
=Col(D2) ——结果仍为D，若忽略第二参数则默认按大写处理
=Col(D2,"a")——结果为d，第二参数小写则结果也小写
=Col(,)——如果在C10输入公式则结果为C，两个参数都忽略时获取当前单元格的大写列标
=Col()——如果在F2输入公式则结果为F，两个参数都忽略时获取公式所在单元格的大写列标
如果需要产生升序的大写字母序列，可以采用以下公式并向右填充：
=col(A1)
点评
Excel自带的Column函数可以获取指定单元格的数字列标，无法获取英文列标，本函数与Column可以做互补。
2. 计算多样式星期
【要求】：对指定日期计算星期，有四种格式可选，包括“一”、“星期一”、“Mon”和“Monday”四种。如果未指定日期则以今天为基准，如果未指定格式则以“星期一”这种中文长写为基准。
【代码】：
Function 星期(Optional dates As Date, Optional style As Byte = 2) ''声明函数名称,具有两个可选参数
IF dates = 0 Then dates = Date ''如果忽略第一参数,则以当日计算
''如果仅一个参数,则参数在1到4之间,则将参数值赋予第二参数,而将当前日期赋予第一参数
IF dates < 5 And dates > 1 Then style = dates: dates = Date
Select Case style ''根据第二参数值选择星期的格式
Case 1 ''第二参数为1
星期 = WorksheetFunction.Text(dates, "aaa") ''短写中文
Case 2
星期 = WorksheetFunction.Text(dates, "aaaa") ''长写中文
Case 3
星期 = WorksheetFunction.Text(dates, "ddd") ''短写英文
Case 4
星期 = WorksheetFunction.Text(dates, "dddd") ''长写英文
End Select
End Function
提示
（1）第一参数声明为日期类型，那么当忽略第一参数时，不能用IsMissing来判断，只能判断它是否等于0。而当日期参数声明为可选参数时不能像第二参数一样直接赋予一个默认值：Date或者Now，因为声明变量时只能用常数。为了解决这个问题，只能在代码中间根据其特征判断用户在录入公式时是否已经忽略该参数。
（2）本函数实例实现了自动判断所忽略的是哪一个参数的功能，即当忽略两个可选参数中的一个时，函数会判断用户忽略的是哪一个。如果唯一的参数值在1到4之间，则将其赋予第二参数，将当前日期赋予第一参数。否则将唯一的参数当作第一参数计算，而第二参数以默认值2参与计算。
【测试】：
在工作表中录入以下公式测试星期函数：
=星期()——假设今天是2009-4-28，则结果为“星期二”，中文长写格式
=星期(,3) ——假设今天是2009-4-28，则结果为“Tue”
=星期("2000-2-29",1)——结果等于“二”
=星期(A1,4) ——如果A1为“1998-12-20”，则结果等于“Sunday”
=星期(4) ——假设今天是2009-4-28，则结果为“Tuesday”
点评
Excel自带函数TEXT可以实现四种星期格式的运算，但其参数对于新手来说不方便记忆。开发自定义函数时需要突破这种屏障，尽量用最简单的参数表示出来；另一个值得学习的是本函数所有参数全是可选的，为用户提供最大的便利。
5.5开发带有不确定参数的Function过程
1. 串联内存数组及选区
【要求】：按要求将内存数组中每个元素串联成一个字符串，同时对选定区域也进行串联。
【代码】：
Function Connect(ParamArray Rng() As Variant) ''声明函数名称,有多个可选参数,包括1到255个
Dim cell As Range, celll As Range, i As Integer, cellv As Variant ''声明变量
Connect = "" ''将函数初始化
''遍历参数所有代码的对象集合(可能是字符串,可能是区域,也可能是数组)
For i = 0 To UBound(Rng)
IF Not IsMissing(Rng(i)) Then ''如果有参数
Select Case TypeName(Rng(i)) ''根据参数的类型决定计算方式
Case "Range"''如果是单元格
''如果参数设置过大,仅仅对参数与已用区域的重叠部分进行计算
Set celll = Application.Intersect(Rng(i), ActiveSheet.UsedRange)
For Each cell In celll''遍历单元格区域
Connect = Connect & cell''串联所有单元格字符
Next cell
Case "Variant()"''如果是数组(包括内存数组)
For Each cellv In Rng(i)''遍历数组
''跳过false,将数组中其他元素串联
IF cellv <> false Then Connect = Connect & cellv
Next cellv
Case Else''否则
Connect = Connect & Rng(i)''直接连接(指直接在参数中输入的字符串)
End Select
End IF
Next i
End Function
提示
不确定参数的函数必须使用ParamArray进行声明参数，使用ParamArray时需要遵循三个规则：
（1）ParamArray所声明的参数必须位于最后位置，即除了ParamArray声明的参数外还有其他参数时，该参数必须位于ParamArray声明的参数的左方。
（2）ParamArray所声明的参数必须用Variant数据类型。
（3）Intersect的作用是让函数只计算数据区域与参数所有代码区域的重叠区，防止整列、整行或者整个工作表作为参数造成死机。但它同时也带来了一个缺点：参数只能引用本工作表的区域，引用其他工作表或者工作簿的区域时，将会忽略。
本函数在Excel 2007中具有0到255个参数，而在Excel 2003中则只有0到30个参数。每个函数都是可选的。
【测试】：
工作表中有如图6.20所示数据，为了将工号大于2000的员工的姓名串联成一个字符串，在单元格D2中录入以下数组公式：
= Connect(IF(B2:B10*1>2000,A2:A10))
公式必须用【Ctrl+Shift+Enter】三键组合录入才能得到正确结果。
图20 串联内存数组
如果需要串联A列所有姓名，那么可以使用以下公式：
=Connect(A2:A10)
如果需要对常量数组进行连接，也可以使用以下公式：
=Connect({"A","DD","S"},{1,7,100})
点评
Excel自带两个连接文件的函数：CONCATENATE和&。然而它们共同的缺点都是不能对区域进行批量操作，也不能对数组进行串联，这使两个函数在工作中受到极大的限制。而自定义函数可以突破这两个限制，完成更复杂的工作，这也是本函数的亮点。
2. 统计多区域公式个数
【要求】：对多个区域计算含有公式的单元格的个数。
【代码】：
Function Functions(ParamArray rng() As Variant)‘声明函数名称,有多个可选参数,包括1到255个
Dim cell, Fun_count As Long, i As Byte, celll As Range ''声明变量
IF UBound(rng) = -1 Then Functions = 0: Exit Function ''如果无参数则结果为0
For i = 0 To UBound(rng)''遍历每个参数
IF Not IsMissing(rng(i)) Then''如果有参数
Set celll = Application.Intersect(rng(i), ActiveSheet.UsedRange)
For Each cell In celll''遍历区域中每个元素
IF cell.HasFormula Then Fun_tion = Fun_tion + 1 ''如果有公式则累加变量
Next cell
End IF
Next i
Functions = Fun_tion ''统计结果
End Function
提示
（1）在本函数的参数中，Rng是变体型，作为数组处理。那么进入For循环时默认下标为0，不能使用For I = 1 to UBound(Rng)。如果参数声明为Range对象，那么其下标才是1。
（2）同前一个函数一样，只能对当前表区域统计公式个数。
【测试】：
在图6.21所示工作表中，为了统计C列和F列具有多个公式，可以使用以下公式进行计算：
=Functions(C:C,F:F)
公式可以使用1到255个参数，还可以累加区域。但是参数引用的区域不可以包含公式所在单元格。
图21 统计区域中的公式个数
点评
工作表函数可以统计空单元格个数、数字个数、文本个数、大于或小于某值的个数等。本公式用于计算区域中的公式个数，算是对函数功能的补充。
5.6开发具有三个参数其中第三个为可选的Function过程
1. 按单元格背景颜色进行条件平均
【要求】：按条件对与条件区域同等大小的统计区域计算平均，如果不指定统计区域则以条件区域进行计算。
【代码】：
Function AverageIFcol(条件区 As Range, 颜色单元格 As Range, Optional 统计区) ''声明函数名称,有三个参数,第三个是可选参数
Dim i As Integer, Counts As Integer, rng As Range, sum As Double''声明变量
Application.Volatile''声明为易失性函数
IF IsMissing(统计区) Then Set rng = 条件区''如果第三参数被忽略,则将条件区赋予rng变量
''如果未被忽略,那么以统计区第一个单元格为基准,向下扩充到条件区同等大小的区域赋予变量Rng
IF Not IsMissing(统计区) Then Set rng = 统计区(1).Resize(条件区.Rows.Count, 条件区.Columns.Count)
For i = 1 To 条件区.Count ''遍历条件区
''如果条件区中某个单元格背景色与颜色单元格区域(参照区)颜色一致,那么
IF 条件区(i).Interior.Color = 颜色单元格(1).Interior.Color Then
sum = sum + rng(i).Value''累加符合条件的数据
Counts = Counts + 1''统计符合条件的个数
End IF
Next i
AverageIFcol = sum / Counts''最后结果等于总和除以个数
End Function
提示
（1）Rng是一个中间变量，用它来替代实际统计区。当有第三参数时则等于第三参数，但参照条件区的大小；当忽略第三参数时则等于第一参数。
（2）为了体现通用性，计算单元格的背景色时必须使用Color，而不能用ColorIndex，否则在Excel 2003中可以使用，在Excel 2007中却无法正常使用。
【测试】：
对于图6.22中的数据，对背景是黄色的学生的成绩计算平均。可用以下公式：
=AVERAGEifcol(K9:K17,K10,L9)
如果条件区和实际统计区是一个区域，可以忽略第三参数，如图6.23所示。
图22　按颜色条件对统计区求平均
图23　按颜色条件对条件区求平均
点评
Excel本身有条件求和函数——SUMIF，但无法与单元格颜色作为参照。本函数可以作为SUMIF函数的补充，它与SUMIF函数的用法一致。
2. 按颜色从左向向右查找所有数据
【要求】：根据参照颜色对查找区域最左列查找同颜色的单元格，然后返回其右边若干列的数据。如果找到多个符合条件的数据，需要全部罗列出来。
【代码】：
''声明函数名称,有三个参数,第三个是可选参数,函数的结果是数组
Function VlookupCol(查找值 As Range, 查找区域 As Range, Optional 列数 As Byte = 2) As Variant
Dim Col As Long, cell As Range, arr(), i As Byte ''声明变量
Application.Volatile''声明为易失性函数
Col = 查找值.Interior.Color''获取参照单元格的背景色
''遍历查找区域的最左边一列
For Each cell In 查找区域(1).Resize(查找区域.Rows.Count, 1)
IF cell.Interior.Color = Col Then''如果与参照颜色一致
i = i + 1''累加变量
ReDim Preserve arr(1 To i)''重新声明数据大小,且保持数组原数据
arr(i) = cell.Offset(0, 列数 - 1)''将找到的单元格右边对应的数值赋予数组
End IF
Next cell
VlookupCol = WorksheetFunction.Transpose(arr)''将数组的结果赋予函数
End Function
提示
（1）Resize属性用于调整指定区域的大小。在本例中因需要取得查找区域的最左边一列，所以需要借助Resize来重置区域，将行限定为原区域行数，将列限定为1。
（2）因每找到一个目标就需要重置数组Arr的大小，且重置时需要保留原数组的值，所以循环中必须加入“ReDim Preserve”来声明数组。
（3）Arr数组是横向数组，本例中利用工作表函数Transpose将它转置为纵向数组，再赋予函数。
（4）函数的结果是数组，如果以普通公式录入可以取得第一个查到的目标；以区域数组形式录入也可以返回所有查到的结果，假设存在多个符合条件的目标值的话。
【测试】：
在图24所示工作表中，A列的姓名以不同背景颜色进行区分，在E1单元格有需要查找的参照颜色，在E2单元格录入以下普通公式可以返回第一个查到的目标数值41：
=VlookupCol(E1,A2:B11,2)
如果需要将符合条件的所有数据全部罗列出来，则需要使用区域数组公式。选择E2:E11区域并录入以下数组公式：
=VlookupCol(E1,A2:B11,2)
必须按【Ctrl+Shift+Enter】三键结束才可以得到正确结果，如图6.25所示。
图24 按颜色获取第一个目标值
图25 按颜色获取所有目标值
因为无法确定有多少个符合条件的值，那么使用区域数组公式时无法把握好区域大小，即既要将所有结果显示出来，又不能出现错误值“#N/A”，那么可以套用Index来完成。
=IFERROR(INDEX(VlookupCol(E$1,A$2:B$11,2),ROW(A1)),"")
在F1录入公式后，将公式向下填充即可。
图26 利用普通公式返回所有结果并排除错值
点评
本函数可以实现按颜色进行查找，是Vlookup函数的补充。另外对于会用vlookup函数的读者一定有一个心得：vlookup只能返回一个符合条件的目标值。使用其他函数与vlookup嵌套后可以实现查找所有目标值，但公式很长，也不利于大众理解。所以在自己开发函数时，应尽量完善，且多一些可选项，让终端用户感觉实用且灵活。
附件: 你需要登录才可以下载或查看附件。没有帐号？轻松注册
站内采录编号: 151020
举报
罗刚君

荣誉版主
终身隐身奖

ET图书作者

串个门
加好友
打招呼
发消息
来自 悠ｅ派 [报名]
7楼
发表于 2011-7-3 23:31:44 |只看该作者
本帖最后由 罗刚君 于 2011-7-3 23:48 编辑
6 编写函数帮助
用户自定义的函数不管自己使用还是给其他用户使用，都有必要对函数的功能和参数添加一个说明，使用户在使用上更加方便。不仅如此，还有必要对函数进行分类，例如大写函数应该划入财务函数类，那么通过插入函数的向导可以从财务函数下拉列表中找到该函数。
如果打开插入函数向导，可以发现所有自定义函数默认存在于“用户定义”类别中，如图27所示。
而双击进入“函数参数”对话框后可以发现，函数的功能没有相应的说明，每个参数的说明全是空白。如图28所示。
图27 用户定义类别中的自定义函数列表
图28  函数参数对话框
为了解决这两个问题，需要简单的定义函数的帮助信息。
VBA中用于指定函数说明的是Application.MacroOptions方法。
Application.MacroOptions方法的基本语法是：
Application.MacroOptions(Macro, Description, HasMenu, MenuText, HasShortcutKey, ShortcutKey, Category, StatusBar, HelpContextID, HelpFile)
各参数的函数如表4所示。
表4 MacroOptions参数说明
名    称
必选/可选
描    述
Macro
可选
用户定义函数 (UDF) 的名称
Description
可选
函数的描述
HasMenu
可选
忽略该参数
MenuText
可选
忽略该参数
HasShortcutKey
可选
如果为 true，则为宏指定一个快捷键；如果该参数为 false，则不为宏指定快捷键
ShortcutKey
可选
如果参数为true，则该参数为必选参数；否则忽略该参数快捷键
Category
可选
一个指定现有的宏函数类别的整数，以确定映射为内置类别的整数，还可指定自定义类别的字符串。如果提供了一个字符串，它将作为类别名称显示在“插入函数”对话框中，如果此类别名称从未使用过，则将用该名称定义一个新的类别，如果使用的类别名称与某个内置名称相同，则 Excel 会将用户定义的函数映射为此内置类别
StatusBar
可选
宏的状态栏文本
HelpContextID
可选
一个指定分配给宏的帮助主题上下文 ID 的整数
HelpFile
可选
包含 HelpContextId 定义的帮助主题的帮助文件名
其中Category表示函数的类型。用户可以将自定义函数添加到属于自己的独有类型中，例如：
Application.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写", Category:="andy专用"
以上代码用于将“大写”函数加入到名为“andy专用”的新类别中，如图6.29所示。
图29 将函数加入新类别中
当然也可以使用内置的函数类别，例如“财务”、“文本”、“逻辑”等。在代码中，可以直接使用类别名，也可以使用其常数值。值与类别的对应关系如表5所示。
表5 内置函数类别
值
类    别
值
类    别
1
财务
8
逻辑
2
日期与时间
9
信息
3
数学与三角函数
10
命令
4
统计
11
自定义
5
查找与引用
12
宏控件
6
数据库
13
DDE/外部
7
文本
14
用户定义
根据上表的分析，如需要将自定义函数加入“文本”类，可以用以下语句：
Application.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写", Category:=7
Application.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写", Category:="文本"
以上两句代码的效果一致，都可以将“大写”函数加入到内置的函数类别“文本”中。
MacroOptions方法仅对自定义函数生效，内置函数的任何说明性文字和分类都无法修改。
使用MacroOptions方法添加函数的帮助分为两类：普通工作簿和加载宏。基于普通工作簿与加载工作簿的特性不同，在设置函数说明时需要区别对待。
1. 普通工作簿
当普通工作簿文件中有自定义函数时，例如“大写”函数，利用以下一个自启动的程序添加函数说明，即每次加载工作簿时执行。
（1） 如果当前工程中有“大写”自定义函数，那么在VBE界面是单击【插入】\【模块】；
（2）在模块中录入以下自启动程序代码，该过程可以在工作簿每次开启时全自动执行：
Sub auto_open()
Application.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写：仅需要一个参数，单元格引用。" + Chr(10) + "例如：“=大写(a1)”", Category:="财务"
End Sub
（3）保存代码后退出Excel，再重新打开工作簿；
（4）打开“插入函数”向导，在“或选择类型”下拉列表中选择“财务”，“大写”函数即位于该类别中，如图30所示。
（5）双击“大写”函数打开“函数参数”对话框 ，在对话框中有关于“大写”函数的功能、参数说明及用法，如图31所示。
图30 财务函数中的“大写”函数
图31 自定义函数的参数说明
以后不管任何时间打开该工作簿，都可以在插入函数的向导中看到关于“大写”函数的信息，方便用户使用。
图32  加载宏中添加函数说明时的错误提示
2. 加载宏工作簿
前一种方法如果用在加载宏（xla格式或者xlam格式）文件中，在开启该加载宏时将会产生如图6.32所示的错误提示。
这是由VBA的规则决定的：在加载宏文件（加载宏的工作簿处于隐藏状态）中，不可以利用代码编辑宏。而控制文件是否具有加载宏属性的方法是改变其IsAddin属性。
所以方法一的代码需要修改为：
Sub auto_open() ''每次开启工作簿时执行
With Application
.ScreenUpdating = false''关闭屏幕更新,防止闪屏
ThisWorkbook.IsAddin = false ''显示加载宏工作簿
''添加函数说明
.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写:仅需要一个参数,单元格引用。" + Chr(10) + "例如："=大写(a1)"", Category:="财务"
ThisWorkbook.IsAddin = true ''还原为加载宏
End With
End Sub
图33 退出Excel程序时弹出的对话框
修改后的代码中，利用“IsAddin = false”，使加载宏工作簿由隐藏状态还原为显示状态，然后再借用MacroOptions方法设置函数的说明信息，最后恢复其隐藏状态。
然而利用IsAddin控制其状态切换将带来两个负面作用：
（1）在对工作簿显示状态进行切换时，将会闪屏一次，给用户不舒服的感觉。所以代码中的“ScreenUpdating = false”则用于解决这个问题；
（2）因MacroOptions方法修改了工作簿中宏的属性，在退出Excel程序时，每次都会弹出一个如图6.33所示对话框。程序会询问用户是否保存加载宏，这是一个令人极其无法接受的事。
为了杜绝这个问题，必须在工作簿的关闭事件中加入以下代码：
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ThisWorkbook.Close (false)
End Sub
代码的含义是每次关闭当前工作簿时都不保存，从而屏蔽提示框。
虽然改为不用关闭工作簿，而直接在“auto_open”过程加入一句保存工作簿的代码也可以解决这个问题，但它将浪费一些不必要的时间。
除以上两种方法外，还有一种更简单的方式——在立即窗口执行MacroOptions方法。
使用立即窗口是基于一个前提条件：Excel会记录并保存MacroOptions的操作。也就是说只要第一次利用MacroOptions方法设计好后，函数中的说明就永远存在，从而避免每次启动都调用代码。
具体的步骤如下：
打开带有函数的工作簿，使用快捷键【Alt+F11】进入VBE界面；
双击Thisworkbook打开工作簿事件代码窗口，使用快捷键【Ctrl+G】显示立即窗口；
在立即窗口中输入以下代码：
application.MacroOptions Macro:="大写", Description:="将阿拉伯数字转为人民币金额大写:仅需要一个参数,单元格引用。" + Chr(10) + "例如："=大写(a1)"", Category:="财务"
在该行代码最右边单击回车键，表示执行语句；
保存工作簿并删除立即窗口中的代码即可。重新启动后在插入函数向导中可以看到该语句产生的函数说明，且永久生效。
如果工作簿中有多个自定义函数，那么可以录入多句代码并复制到立即窗口中，然后分别执行。分别执行，记住这一点很重要，立即窗口一次只能执行一行代码，所以复制三行代码到立即窗口后，需要将光标定位于每句的末尾单击一次回车键，以此类推。
3. 如何让函数说明通用于Excel 2003和Excel 2007
在编写函数的说明时，有必要了解Excel 2003和Excel 2007中的一些差异，从而在编写代码时尽量做到代码通用。
对于函数的处理Excel 2003和Excel 2007存在两方面的差异。
（1）说明文字的长度不同。在Excel 2003和Excel 2007中，利用MacroOptions方法添加的说明字符串长度是不相同的。Excel 2003的函数参数对话框仅仅能容下150个字符以内的说明信息。Excel 2007虽然可以达到200个字符以上，但为了兼容性，尽量在150个字符之内将函数的功能、参数、用法完全说明白，否则用户在Excel 2003中使用时会看不到部分字符；
（2）最大参数不同。当函数使用了ParamArray声明不确定参数时，其参数个数的上限是不同的。在Excel 2003中，最多可以使用30个参数，而在Excel 2007中最多可以使用255个参数。所以为了让函数的说明能够适用于Excel 2003和Excel 2007，需要使用一些技巧。
解决办法是：利用Version属性判断Excel程序的版本，如果不是Excel 2007则使用30，否则使用255。代码如下：
Sub 加入函数提示()
Dim counts As Byte
IF Application.Version * 1 <= 11 Then counts = 30 Else counts = 255
ThisWorkbook.IsAddin = false
Application.MacroOptions Macro:="我的自定义函数", Description:="本函数具有" & counts & "个参数,其中......", Category:="财务"
ThisWorkbook.IsAddin = true
End Sub
补充：Excel 2010中，Application.MacroOptions 方法增加了个可选参数ArgumentDescriptions，它表示“函数参数”对话框中显示的参数的描述。 换一种说法即通过它添加自定义函数的参数说明。
例如：
Function A(B, C) As String
A = B & C
End Function
Sub 创建参数说明()
Application.MacroOptions Macro:="a", ArgumentDescriptions:=Array("第一参数", "第二参数")
End Sub
执行过程“创建参数说明”后，自定义函数的参数B和C将出现参数说明。如下图所示：
图34 参数说明
总结
Function过程即自定义函数，根据工作需要可以开发自己专用的函数。
对于函数的运算速度，内部集成的工作表函数一定快于用户自己定义的函数，在内部函数能够完成的情况下尽量使用工作表函数；如果工作表函数无法完成，或者需要非常长的数组公式才能完成的情况下，可以开发专用的自定义函数。
开发自定义函数时，应该尽量给用户一些可选项，使函数运用更简单，公式也更简短。例如内部函数Left，取左边第一个字符时可以忽略第二参数。
对于某些运算结果，如果工作中常见格式较多，应尽可能将所有格式全部罗列出来，让用户选择。例如本章定义的星期函数，支持四种显示方式。
对于有多个结果的函数，应将函数声明为数组，将所有结果显示给用户。但为了体现灵活性，同时需要指定一种默认显示的值。例如自定义函数VlookupCol，相对内部函数Vlookup在某些方面具有独特的优越性。
为了让用户自定义的函数在任何工作簿中都可以应用，应将工作簿保存为加载宏文件，并对其加载或者置于自启动文件夹。对于加载宏文件的生成方法参见本书第31章。
最后，为了让用户能更快掌握开发者定义函数的功能，应对函数编写说明，且对其归类。

http://www.exceltip.net/thread-23148-1-1.html