《第3章 使用VBA开发自定义函数.pdf》由会员分享，可在线阅读，更多相关《第3章 使用VBA开发自定义函数.pdf（14页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 第第3章 使用章 使用 VBA 开发自定义函数开发自定义函数 在前面的例子中创建和使用的都是子过程，它通常都可以完成某一种功能。函数过程则是为了完成某种计算，并返回一个计算结果。在 VBA 中创建的函数过程不但可以在 VBA 中使用，而且还可以像其他 Excel 内置工作表函数一样，在工作表的公式中使用。本章将重点介绍创建自定义函数并在工作表公式中使用的方法。 3.1 了解函数过程中的参数在 Excel 工作表公式中使用不同的函数时，通常都需要输入函数的参数，然后函数才能得出正确结果。当然，有极少一部
2、分函数不需要参数，例如时间函数 Now，在单元格中输入“=Now()”并按【Enter】键后，将得到当前的时间。 在 VBA 中编写自定义函数时，也要根据函数的功能为自定义函数设计不定数量的参数，以便在使用中用户可以给函数参数赋值而获得想要的结果。本节将介绍自定义函数参数的几种类型。 3.1.1 不使用参数的函数 自定义函数可以不使用任何参数， 这通常在需要通过自定义函数返回一个信息时使用。例如，下面的自定义函数返回当前工作簿的路径，它不需要使用任何参数： Function GetPath() GetPath = ActiveWorkbook.FullName End Function 当在单
3、元格中输入“=GetPath()”并按【Enter】键后，将在单元格中显示当前工作簿的路径，如图 3-1所示。当在单元格输入等号“=”后，可以通过 Excel 2013 的自动完成功能在列表中找到自定义函数。 图 3-1 使用无参数函数返回工作簿路径 提示：与 Excel 内置的工作表函数一样，即使自定义函数不使用参数，但是在输入函数时也要包含一对圆括号。 37人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 3.1.2 使用有个参数的函数 有时可能需要通过给定一个数值来获得结果。例如，在使用 Excel 的工作表函数 ABS时，通过给定一个数字，返
4、回它的绝对值。那么在自定义函数时，也可以为函数设置一个参数，在公式中使用自定义函数时，也要输入一个参数，才能得出正确结果。 例如，下面的自定义函数通过用户输入一个数字，来求得该数字的阶乘： Function CountF(Num) Dim i As Integer Dim Total As Long Total = 1 For i = 1 To Num Total = Total * i Next i CountF = Total End Function 在工作表中输入该函数时，要求输入一个参数，例如，输入“=CountF(5)” ，按【Enter】键后，将得到给定参数值的阶乘，如图 3-2
5、所示。 图 3-2 使用一个参数的函数计算数字的阶乘 3.1.3 使用多个参数的函数 如果需要参与计算的条件较多，一个参数不够用时，那么可以在自定义函数中设置多个参数。例如，可以创建一个自定义函数，根据给定的商品单价和销售数量，计算员工的销售提成金额。当销售额小于 20000 时，以销售额的 6%作为提成金额；当销售额在 20001到 40000 之间时，以销售额的 8%作为提成金额；如果销售额大于 40000，那么以销售额的10%作为提成金额。下面的自定义函数正是用来计算这种提成方法的： Function GetBonus(UPrice, Amount) Dim Total As Long
6、Total = UPrice * Amount Select Case Total Case 0 To 20000 GetBonus = Total * 0.06 Case 20001 To 40000 GetBonus = Total * 0.08 38人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 Case Else GetBonus = Total * 0.1 End Select End Function 在公式中输入上面的自定义函数 GetBonus，并指定函数中的两个参数，商品单价和销售量，将得到提成金额，如图 3-3所示。 图 3-3
7、 通过两个参数的自定义函数计算销售提成 提示：如果两个参数仍不够，还可以设置更多个参数，其创建和使用方法与包含两个参数的自定义函数是相同的。 3.1.4 使用整个区域作为参数的函数 在 Excel 内置工作表函数中，有些函数需要用户提供表示区域的参数，然后根据给定的区域返回某个符合条件的值。例如，对于 Large 函数，它可以返回指定区域中的第几个最大的值。但是如果要计算区域中前 n 大的值之和的百分之几，那么使用包含 Large 函数的公式是相当麻烦的。 例如，要计算区域 A1:D4 中前 3 大的数值的 10%，那么需要使用下面这个公式： =(LARGE(A1:D4,1)+LARGE(A1
8、:D4,2)+LARGE(A1:D4,3)*10% 如果现在要计算区域 A1:D4 中前 5 大的数值的 15%，那么修改上面的公式是不是很麻烦呢？这时可以通过自定义函数来简化公式输入的麻烦。 Function LargePercent(Range, LargeNum, Percent) Dim i As Integer Dim Total As Long For i = 1 To LargeNum Total = Total + WorksheetFunction.Large(Range, i) Next i LargePercent = Total * Percent End Functi
9、on 上面的公式使用参数 Range 指定要参加计算的单元格区域，然后通过 LargeNum 给定要参加计算的前几大的值的数量，通过 Percent 参数指定用于计算的百分比值。在工作表中输入上面的自定义函数，并指定 3 个参数，即可得到计算结果，如图 3-4所示。 39人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 图 3-4 使用区域参数进行复杂计算 3.2 创建与使用自定义函数创建自定义函数需要在 VBE 窗口中的标准模块中进行， 不能将自定义函数的代码写到ThisWorkbook 模块或工作表（例如 Sheet1）模块中。如果在这些模块中创
10、建自定义函数，那么 Excel 将无法了解用户创建的是自定义函数。 3.2.1 创建自定义函数 通过3.1节的几个例子，相信您已经大致了解自定义函数是如何工作的。本节将介绍创建自定义函数的通用步骤，其实创建过程是非常简单的，具体操作如下： （1）启动 Excel 2013，单击功能区中的【开发工具】?【代码】?【Visual Basic】按钮。如果没显示【开发工具】选项卡，可添加该选项卡或直接按【Alt+F11】组合键。 （2）打开 VBE 窗口，在工程资源管理器中插入一个模块（右键单击后选择【插入】?【模块】命令） 。一定不要在 ThisWorkbook 或 Sheet 模块中输入自定义函数
11、的代码。 （3）在右侧的代码窗口中，输入“Function” ，然后在同一行输入函数名，按【Enter】键，自动加上函数过程的外壳。 （4）在 Function 和 End Function 之间输入自定义函数的代码。 完成自定义函数的创建后，即可在工作表公式中或其他 VBA 过程中使用该函数。 3.2.2 在工作表公式中使用自定义函数 当创建好自定义函数后， 就可以像使用Excel内置工作表函数一样， 来使用自定义函数。在3.1节的例子中，已经介绍过可以在单元格中通过手工的方法来输入自定义函数。如果您不喜欢这种方式，那么可以使用【插入函数】对话框。具体操作如下： （1）单击要输入函数的单元格
12、，然后单击公式栏左侧的【插入函数】按钮。 （2）打开【插入函数】对话框，选择【或选择类别】列表中的【用户定义】类别。在【选择函数】列表框中可以看到当前可以使用的自定义函数，如图 3-5所示。 40人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 图 3-5 在【用户定义】类别中可以找到自定义的函数 （3）选择好要使用的函数，然后单击【确定】按钮。打开【函数参数】对话框，在该对话框中依次输入自定义函数的参数，如图 3-6所示。 图 3-6 在【函数参数】对话框中输入自定义函数的参数 （4）输入好自定义函数的参数后，单击【确定】按钮，即可得到计算结果。
13、3.2.3 在 VBA 过程中调用自定义函数 除了在 Excel 工作表公式中使用自定义函数外， 也可以在 VBA 其他过程中调用自定义函数过程。由于函数过程通常都会返回一个值，因此，可以在子过程中将函数过程的计算结果赋值给一个变量，然后使用该变量再进行其他操作。例如，下面的代码调用前面例子中的计算提成金额的函数过程“GetBonus”中，然后根据在单元格 A1 和 B1 中输入的单价和销售量，最后通过提示信息显示计算后的提成金额，如图 3-7所示。 Sub 计算提成() Dim i As Integer, j As Integer 41人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电
14、子书Excel 2013 VBA 篇 i = ActiveSheet.Range(A1) j = ActiveSheet.Range(B1) MsgBox 您的提成金额为： & GetBonus(i, j) End Sub 图 3-7 在 VBA 过程中调用函数过程 3.2.4 设置自定义函数的说明信息 如果在【插入函数】对话框中选择的是 Excel 内置的工作表函数，那么会在该对话框的下方显示所选函数的说明信息。但是如果选择的是自定义函数，则不会显示函数的信息，这需要用户手工设置。具体操作如下： （1）打开包含自定义函数的工作簿，然后单击功能区中的【开发工具】?【代码】?【宏】按钮。 （2）
15、打开【宏】对话框，在【宏名称】文本框中输入要添加说明信息的自定义函数名称，如图 3-8所示。 （3）单击【选项】按钮，打开【宏选项】对话框，在【说明】文本框中输入自定义函数的说明信息，如图 3-9所示。 42人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 图 3-8 手工输入自定义函数名称 图 3-9 设置自定义函数的说明信息 （4）单击【确定】按钮，完成自定义函数说明信息的设置。以后在【插入函数】对话框选择该自定义函数时，即可看到说明信息，如图 3-10所示。 图 3-10 在选择自定义函数时可以看到说明信息 提示：但是在设置自定义函数的参数时，
16、用户无法为每个参数添加说明信息。 3.2.5 共享自定义函数 如果创建的自定义函数只供自己使用，那么可以将自定义函数保存到个人宏工作簿 Personal.xlsb 中， 这样所有打开的工作簿中都可以使用该自定义函数。 如果 Office 安装到硬盘上的 C 分区，那么个人宏工作簿 Personal.xlsb 的默认位置是： C:Users用户名Application DataMicrosoftExcelXLStart 43人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 上面的用户名是用户登录 Windows 操作系统时的用户名称。如果要将在当前工作
17、簿中创建的自定义函数给其他用户使用，那么需要将包含自定义函数的工作簿制作为一个加载项，然后让需要使用该自定义函数的用户安装该加载项即可。 3.3 自定义函数实例本节将列举一些比较实用的自定义函数实例，它们在使用 Excel 时很有用。 3.3.1 获取当前工作簿的路径和名称 Excel 内置的工作表函数并没有提供用于返回当前工作簿路径和名称的函数， 可以自定义函数来实现这个功能，在前面的例子中也曾经使用过。下面的自定义函数用于返回当前工作簿的路径和名称： Function GetWBPath() GetWBPath = Application.ThisWorkbook.FullName End
18、 Function 在工作表单元格中输入“=GetWBPath()” ，按【Enter】键后即可得到当前工作簿的路径和名称。由如图 3-11所示可以看出，当前包含代码的工作簿存储在“我的文档”文件夹中，即 C:UserssxDocuments 中，工作簿名称为“第 3 章.xlsm” 。 图 3-11 返回当前工作簿的路径和名称 3.3.2 确定单元格数据的类型 下面的自定义函数可以判断不同的单元格中的数据类型，参数 Cell 代表要判断数据类型的单元格。主要使用不同的值类型判断函数，来检测单元格，然后根据检测结果来返回不同的类型名称： Function CellType(Cell As Ra
19、nge) Select Case True Case Application.WorksheetFunction.IsText(Cell) 判断是否为文本 CellType = 文本 Case Application.WorksheetFunction.IsLogical(Cell) 判断是否为逻辑值 CellType = 逻辑值 Case IsEmpty(Cell) 判断是否为空 44人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 CellType = 空值 Case IsNumeric(Cell) 判断是否为数字 CellType = 数值 C
20、ase Application.IsError(Cell) 判断是否为错误值 CellType = 错误值 Case IsDate(Cell) 判断是否为日期 CellType = 日期 End Select End Function 在如图 3-12所示的工作表中，区域 A1:A6 显示了不同类型的数据，而在单元格 B1 中输入下面的公式： =CellType(A1) 将上面的公式向下拖动复制到单元格 B6， 在区域 B1:B6 的每个单元格中将显示区域 A1:A6 中每个单元格的数据类型。 图 3-12 利用自定义函数判断单元格数据的类型 3.3.3 查找区域中第一个非空的单元格 当单元格
21、区域中包含大量的数据时，可以使用下面的自定义函数检查区域中的每一个单元格，并返回第一个非空单元格的值。其中，参数 MyRange 代表要搜索的区域： Function FirstNoBlank(MyRange As Range) Dim Cell As Range For Each Cell In MyRange 遍历区域中的每一个单元格 If Not IsNull(Cell) And Cell Then 如果单元格中不包含无效值或无为空 FirstNoBlank = Cell.Value将单元格的值赋给函数名 Exit Function End If Next Cell FirstNoBla
22、nk = Cell.Value End Function 在如图 3-13所示的工作表中， 区域 A1:A8 中的部分单元格包含数据， 某些单元格为空。 45人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 在单元格 B1 中输入下面的公式： =FirstNoBlank(A1:A8) 按【Enter】键后，将通过自定义函数 FirstNoBlank 检测区域 A1:A8，并返回第一个非空单元格包含的内容，即单元格 A2 中的值。 图 3-13 返回第一个非空单元格的内容 3.3.4 将星期编号转换为日期 也许工作中会遇到以一年中第几周来表示的日期，那
23、么通过周来推算实际的日期（月和日） ，实在是很麻烦。因此，可能就会需要一个用于将星期转换为具体日期的函数。下面的自定义函数可以完成将星期转换为日期的功能，其中，参数 WeekString 代表要转换的星期编号文本，而放置转换结果的单元格需要设置为日期格式： Function WeekDayToDate(WeekString As String) As Date Dim WeekD As Long Dim FirstM As Date Dim TString As String FirstM = DateSerial(Right(WeekString, 4), 1, 1) 提取日期中的年份并返回
24、该年的第一天 FirstM = FirstM - FirstM Mod 7 + 2 获得上一年最后一个星期一的日期 TString = Right(WeekString, Len(WeekString) - 5) 提取除英文字符串 week 和一个空格外的剩余内容 WeekD = Right(TString, InStr(1, TString, , 1) + 0 提取表示星期的数字 WeekDayToDate = FirstM + (WeekD - 1) * 7 将星期数乘以 7 并累加到之前获得的日期中 End Function 在如图 3-14所示的工作表中，区域 A1:A3 中包含了不同
25、日期的星期表示，在单元格 B1 中输入下面的公式： WeekDayToDate(A1) 将此公式向下拖动复制到单元格 B3， 这样会得到将以星期表示的日期格式转换为普通 46人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 日期格式后的结果。 图 3-14 将星期数转换为对应的日期 3.3.5 从文本中提取数字 如果单元格中既包含文本又包含数字，那么可以使用下面的自定义函数。其中，参数AllText 为要提取数字的文本： Function GetNumbersFromText(AllText As String) Dim i As Integer,
26、j As Integer Dim Nums As String For i = Len(AllText) To 1 Step -1 定义循环的计算器变量取值范围 If IsNumeric(Mid(AllText, i, 1) Then 检测文本中每一个字符是否为数字 j = j + 1 Nums = Mid(AllText, i, 1) & Nums 如果检测字符为数字，那么从原字符串中提取该字符并进行拼接 End If If j = 1 Then Nums = CInt(Mid(Nums, 1, 1) Next i GetNumbersFromText = CLng(Nums) End Fu
27、nction 在如图 3-15所示的工作表中， 在单元格 B1 和 B2 中使用自定义函数 GetNumbersFromText，将分别提取出单元格 A1 和 A2 中的数字。 图 3-15 从文本中提取数字 3.3.6 在区域内搜索特定的文本 下面的自定义函数可以根据您指定的字符来搜索它存在于哪个单元格中，如果在区域中的多个单元格都包含指定的字符，那么将显示这些单元格引用，它们之间以逗号分隔。 47人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 其中，参数 MyRange 代表要搜索的区域，FindString 代表要搜索的字符： Functio
28、n FindStringInText(MyRange As Range, FindString As String) Dim T As String Dim Cell As Range For Each Cell In MyRange 遍历区域中的每一个单元格 If InStr(Cell.Text, FindString) 0 Then 判断要查找的内容是否出现在区域中 If Len(T) = 0 Then 检测中间变量的字符串 T 长度是否为 0 T = Cell.Address(False, False) 将单元格的相对引用地址赋给变量 T Else T = T & , & Cell.Ad
29、dress(False, False) 当变量 T不为 0 后，将每次获得的单元格地址与上一次进行拼接，之间用逗号分隔 End If End If Next Cell FindStringInText = T 将最终的变量 T 的结果赋给函数 End Function 在如图 3-16所示的工作表中，单元格区域 A1:A4 包含了要查找的内容，而在单元格 B1 中使用自定义函数 FindStringInText，来查找区域 A1:A4 中包含有“Excel”的单元格，并将查找结果显示在单元格 B1 中。对于图 3-16来说，搜索的结果说明了单元格 A1、A2、A3 中都包含了字符串“Excel
30、” 。 图 3-16 在指定区域内搜素特定的文本 3.3.7 将金额转换为中文大写 在财务工作中，通常需要将阿拉伯数字形式的金额转换为中文大写形式。如果多层嵌套的 IF 函数固然可以完成这项工作，但是公式很长，输入起来容易出错。可以通过创建一个自定义函数，将阿拉伯金额转换为中文大写形式。下面的函数即可完成金额转换功能，其中，Money 代表要转换的阿拉伯数字形式的金额： Function NumToCapsMoney(Money As String) Dim x As String, y As String 48人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013
31、VBA 篇 Dim i As Integer Const zimu = .sbqwsbqysbqwsbq 定义位置代码 Const letter = 0123456789sbqwy.zjf 定义汉字缩写 Const CaseWord = 零壹贰叁肆伍陆柒捌玖拾佰仟萬億元整角分 定义大写汉字 Dim temp As String temp = Money If InStr(temp, .) 0 Then temp = Left(temp, InStr(temp, .) - 1) If Len(temp) 16 Then MsgBox 数目太大，无法换算！请输入一亿亿以下的数字, 64, 错误提示
32、: Exit Function 只能转换一亿亿元以下数目的货币！ x = Format(Money, 0.00) 格式化货币 y = For i = 1 To Len(x) - 3 y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1) Next i If Right(x, 3) = .00 Then y = y & z Else y = y & Left(Right(x, 2), 1) & j & Right(x, 1) & f End If y = Replace(y, 0q, 0) 避免零千(如：40700 肆萬零千零柒佰) y = Rep
33、lace(y, 0b, 0) 避免零百(如：47000 肆萬柒千零佰) y = Replace(y, 0s, 0) 避免零十(如：207 贰佰零拾零柒) Do While y Replace(y, 00, 0) y = Replace(y, 00, 0) 避免双零(如：2006 壹仟零零陆) Loop y = Replace(y, 0y, y) 避免零億(如：120 億壹佰贰十零億) y = Replace(y, 0w, w) 避免零萬(如：120 萬壹佰贰十零萬) y = IIf(Len(x) = 5 And Left(y, 1) = 1, Right(y, Len(y) - 1), y)
34、避免壹十(如：16 壹拾陆；10 壹拾) y = IIf(Len(x) = 4, Replace(y, 0., ), Replace(y, 0., .) 避免零元(如：70.00 柒拾零圆；0.17 零圆柒角贰分) For i = 1 To 19 y = Replace(y, Mid(letter, i, 1), Mid(CaseWord, i, 1) 大写汉字 Next i NumToCapsMoney = y End Function 49人民邮电出版社Excel 公式与函数大辞典配套光盘附赠电子书Excel 2013 VBA 篇 在如图 3-17所示的工作表中， 单元格 A1 中包含了阿拉伯数字格式的金额， 在单元格 B1 中使用自定义函数 NumToCapsMoney 将单元格 A1 中的阿拉伯数字，自动转换为中文大写形式，并在单元格 B1 中显示转化后的结果。 图 3-17 将阿拉伯形式的金额转换为中文大写形式 50