第3章 使用VBA开发自定义函数

人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇第3章使用VBA开发自定义函数在前面的例子中创建和使用的都是子过程，它通常都可以完成某一种功能。函数过程则是为了完成某种计算，并返回一个计算结果。在VBA中创建的函数过程不但可以在VBA中使用，而且还可以像其他Excel内置工作表函数一样，在工作表的公式中使用。本章将重点介绍创建自定义函数并在工作表公式中使用的方法。3.1了解函数过程中的参数 在Excel工作表公式中使用不同的函数时，通常都需要输入函数的参数，然后函数才能得出正确结果。当然，有极少一部分函数不需要参数，例如时间函数Now，在单元格中输入“=Now()”并按【Enter】键后，将得到当前的时间。在VBA中编写自定义函数时，也要根据函数的功能为自定义函数不定数量的参数，以便在使用中用户可以给函数参数赋值而获得想要的结果。本节将介绍自定义函数参数的几种类型。3.1.1不使用参数的函数自定义函数可以不使用任何参数，这通常在需要通过自定义函数返回一个信息时使用。例如，下面的自定义函数返回当前工作簿的路径，它不需要使用任何参数：FunctionGetPath()GetPath=ActiveWorkbook.FullNameEndFunction当在单元格中输入“=GetPath()”并按【Enter】键后，将在单元格中显示当前工作簿的路径，如图3-1所示。当在单元格输入等号“=”后，可以通过Excel2013的自动完成功能在列表中找到自定义函数。图3-1使用无参数函数返回工作簿路径提示：与Excel内置的工作表函数一样，即使自定义函数不使用参数，但是在输入函数时也要包含一对圆括号。37人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇3.1.2使用有—个参数的函数有时可能需要通过给定一个数值来获得结果。例如，在使用Excel的工作表函数ABS时，通过给定一个数字，返回它的绝对值。那么在自定义函数时，也可以为函数设置一个参数，在公式中使用自定义函数时，也要输入一个参数，才能得出正确结果。例如，下面的自定义函数通过用户输入一个数字，来求得该数字的阶乘：FunctionCountF(Num)DimiAsIntegerDimTotalAsLongTotal=1Fori=1ToNumTotal=Total*iNextiCountF=TotalEndFunction在工作表中输入该函数时，要求输入一个参数，例如，输入“=CountF(5)”，按【Enter】键后，将得到给定参数值的阶乘，如图3-2所示。图3-2使用一个参数的函数计算数字的阶乘3.1.3使用多个参数的函数如果需要参与计算的条件较多，一个参数不够用时，那么可以在自定义函数中设置多个参数。例如，可以创建一个自定义函数，根据给定的商品单价和销售数量，计算员工的销售提成金额。当销售额小于20000时，以销售额的6%作为提成金额；当销售额在20001到40000之间时，以销售额的8%作为提成金额；如果销售额大于40000，那么以销售额的10%作为提成金额。下面的自定义函数正是用来计算这种提成方法的：FunctionGetBonus(UPrice,Amount)DimTotalAsLongTotal=UPrice*AmountSelectCaseTotalCase0To20000GetBonus=Total*0.06Case20001To40000GetBonus=Total*0.0838人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇CaseElseGetBonus=Total*0.1EndSelectEndFunction在公式中输入上面的自定义函数GetBonus，并指定函数中的两个参数，商品单价和销售量，将得到提成金额，如图3-3所示。图3-3通过两个参数的自定义函数计算销售提成提示：如果两个参数仍不够，还可以设置更多个参数，其创建和使用方法与包含两个参数的自定义函数是相同的。3.1.4使用整个区域作为参数的函数在Excel内置工作表函数中，有些函数需要用户提供表示区域的参数，然后根据给定的区域返回某个符合条件的值。例如，对于Large函数，它可以返回指定区域中的第几个最大的值。但是如果要计算区域中前n大的值之和的百分之几，那么使用包含Large函数的公式是相当麻烦的。例如，要计算区域A1:D4中前3大的数值的10%，那么需要使用下面这个公式：=(LARGE(A1:D4,1)+LARGE(A1:D4,2)+LARGE(A1:D4,3))*10%如果现在要计算区域A1:D4中前5大的数值的15%，那么修改上面的公式是不是很麻烦呢？这时可以通过自定义函数来简化公式输入的麻烦。FunctionLargePercent(Range,LargeNum,Percent)DimiAsIntegerDimTotalAsLongFori=1ToLargeNumTotal=Total+WorksheetFunction.Large(Range,i)NextiLargePercent=Total*PercentEndFunction上面的公式使用参数Range指定要参加计算的单元格区域，然后通过LargeNum给定要参加计算的前几大的值的数量，通过Percent参数指定用于计算的百分比值。在工作表中输入上面的自定义函数，并指定3个参数，即可得到计算结果，如图3-4所示。39人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇图3-4使用区域参数进行复杂计算3.2创建与使用自定义函数 创建自定义函数需要在VBE窗口中的标准模块中进行，不能将自定义函数的代码写到ThisWorkbook模块或工作表（例如Sheet1）模块中。如果在这些模块中创建自定义函数，那么Excel将无法了解用户创建的是自定义函数。3.2.1创建自定义函数通过3.1节的几个例子，相信您已经大致了解自定义函数是如何工作的。本节将介绍创建自定义函数的通用步骤，其实创建过程是非常简单的，具体操作如下：（1）启动Excel2013，单击功能区中的【开发工具】【代码】【VisualBasic】按钮。如果没显示【开发工具】选项卡，可添加该选项卡或直接按【Alt+F11】组合键。（2）打开VBE窗口，在工程资源管理器中插入一个模块（右键单击后选择【插入】【模块】命令）。一定不要在ThisWorkbook或Sheet模块中输入自定义函数的代码。（3）在右侧的代码窗口中，输入“Function”，然后在同一行输入函数名，按【Enter】键，自动加上函数过程的外壳。（4）在Function和EndFunction之间输入自定义函数的代码。完成自定义函数的创建后，即可在工作表公式中或其他VBA过程中使用该函数。3.2.2在工作表公式中使用自定义函数当创建好自定义函数后，就可以像使用Excel内置工作表函数一样，来使用自定义函数。在3.1节的例子中，已经介绍过可以在单元格中通过手工的方法来输入自定义函数。如果您不喜欢这种方式，那么可以使用【插入函数】对话框。具体操作如下：（1）单击要输入函数的单元格，然后单击公式栏左侧的【插入函数】按钮。（2）打开【插入函数】对话框，选择【或选择类别】列表中的【用户定义】类别。在【选择函数】列表框中可以看到当前可以使用的自定义函数，如图3-5所示。40人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇图3-5在【用户定义】类别中可以找到自定义的函数（3）选择好要使用的函数，然后单击【确定】按钮。打开【函数参数】对话框，在该对话框中依次输入自定义函数的参数，如图3-6所示。图3-6在【函数参数】对话框中输入自定义函数的参数（4）输入好自定义函数的参数后，单击【确定】按钮，即可得到计算结果。3.2.3在VBA过程中调用自定义函数除了在Excel工作表公式中使用自定义函数外，也可以在VBA其他过程中调用自定义函数过程。由于函数过程通常都会返回一个值，因此，可以在子过程中将函数过程的计算结果赋值给一个变量，然后使用该变量再进行其他操作。例如，下面的代码调用前面例子中的计算提成金额的函数过程“GetBonus”中，然后根据在单元格A1和B1中输入的单价和销售量，最后通过提示信息显示计算后的提成金额，如图3-7所示。Sub计算提成()DimiAsInteger,jAsInteger41人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇i=ActiveSheet.Range("A1")j=ActiveSheet.Range("B1")MsgBox"您的提成金额为："&GetBonus(i,j)EndSub图3-7在VBA过程中调用函数过程3.2.4设置自定义函数的说明信息如果在【插入函数】对话框中选择的是Excel内置的工作表函数，那么会在该对话框的下方显示所选函数的说明信息。但是如果选择的是自定义函数，则不会显示函数的信息，这需要用户手工设置。具体操作如下：（1）打开包含自定义函数的工作簿，然后单击功能区中的【开发工具】【代码】【宏】按钮。（2）打开【宏】对话框，在【宏名称】文本框中输入要添加说明信息的自定义函数名称，如图3-8所示。（3）单击【选项】按钮，打开【宏选项】对话框，在【说明】文本框中输入自定义函数的说明信息，如图3-9所示。42人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇图3-8手工输入自定义函数名称图3-9设置自定义函数的说明信息（4）单击【确定】按钮，完成自定义函数说明信息的设置。以后在【插入函数】对话框选择该自定义函数时，即可看到说明信息，如图3-10所示。图3-10在选择自定义函数时可以看到说明信息提示：但是在设置自定义函数的参数时，用户无法为每个参数添加说明信息。3.2.5共享自定义函数如果创建的自定义函数只供自己使用，那么可以将自定义函数保存到个人宏工作簿Personal.xlsb中，这样所有打开的工作簿中都可以使用该自定义函数。如果Office安装到硬盘上的C分区，那么个人宏工作簿Personal.xlsb的默认位置是：C:\Users\用户名\ApplicationData\Microsoft\Excel\XLStart43人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇上面的用户名是用户登录Windows操作系统时的用户名称。如果要将在当前工作簿中创建的自定义函数给其他用户使用，那么需要将包含自定义函数的工作簿制作为一个加载项，然后让需要使用该自定义函数的用户安装该加载项即可。3.3自定义函数实例 本节将列举一些比较实用的自定义函数实例，它们在使用Excel时很有用。3.3.1获取当前工作簿的路径和名称Excel内置的工作表函数并没有提供用于返回当前工作簿路径和名称的函数，可以自定义函数来实现这个功能，在前面的例子中也曾经使用过。下面的自定义函数用于返回当前工作簿的路径和名称：FunctionGetWBPath()GetWBPath=Application.ThisWorkbook.FullNameEndFunction在工作表单元格中输入“=GetWBPath()”，按【Enter】键后即可得到当前工作簿的路径和名称。由如图3-11所示可以看出，当前包含代码的工作簿存储在“我的文档”文件夹中，即C:\Users\sx\Documents中，工作簿名称为“第3章.xlsm”。图3-11返回当前工作簿的路径和名称3.3.2确定单元格数据的类型下面的自定义函数可以判断不同的单元格中的数据类型，参数Cell代表要判断数据类型的单元格。主要使用不同的值类型判断函数，来检测单元格，然后根据检测结果来返回不同的类型名称：FunctionCellType(CellAsRange)SelectCaseTrueCaseApplication.WorksheetFunction.IsText(Cell)'判断是否为文本CellType="文本"CaseApplication.WorksheetFunction.IsLogical(Cell)'判断是否为逻辑值CellType="逻辑值"CaseIsEmpty(Cell)'判断是否为空44人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇CellType="空值"CaseIsNumeric(Cell)'判断是否为数字CellType="数值"CaseApplication.IsError(Cell)'判断是否为错误值CellType="错误值"CaseIsDate(Cell)'判断是否为日期CellType="日期"EndSelectEndFunction在如图3-12所示的工作表中，区域A1:A6显示了不同类型的数据，而在单元格B1中输入下面的公式：=CellType(A1)将上面的公式向下拖动复制到单元格B6，在区域B1:B6的每个单元格中将显示区域A1:A6中每个单元格的数据类型。图3-12利用自定义函数判断单元格数据的类型3.3.3查找区域中第一个非空的单元格当单元格区域中包含大量的数据时，可以使用下面的自定义函数检查区域中的每一个单元格，并返回第一个非空单元格的值。其中，参数MyRange代表要搜索的区域：FunctionFirstNoBlank(MyRangeAsRange)DimCellAsRangeForEachCellInMyRange'遍历区域中的每一个单元格IfNotIsNull(Cell)AndCell<>""Then'如果单元格中不包含无效值或无为空FirstNoBlank=Cell.Value'将单元格的值赋给函数名ExitFunctionEndIfNextCellFirstNoBlank=Cell.ValueEndFunction在如图3-13所示的工作表中，区域A1:A8中的部分单元格包含数据，某些单元格为空。45人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇在单元格B1中输入下面的公式：=FirstNoBlank(A1:A8)按【Enter】键后，将通过自定义函数FirstNoBlank检测区域A1:A8，并返回第一个非空单元格包含的，即单元格A2中的值。图3-13返回第一个非空单元格的内容3.3.4将星期编号转换为日期也许工作中会遇到以一年中第几周来表示的日期，那么通过周来推算实际的日期（月和日），实在是很麻烦。因此，可能就会需要一个用于将星期转换为具体日期的函数。下面的自定义函数可以完成将星期转换为日期的功能，其中，参数WeekString代表要转换的星期编号文本，而放置转换结果的单元格需要设置为日期格式：FunctionWeekDayToDate(WeekStringAsString)AsDateDimWeekDAsLongDimFirstMAsDateDimTStringAsStringFirstM=DateSerial(Right(WeekString,4),1,1)'提取日期中的年份并返回该年的第一天FirstM=FirstM-FirstMMod7+2'获得上一年最后一个星期一的日期TString=Right(WeekString,Len(WeekString)-5)'提取除英文字符串week和一个空格外的剩余内容WeekD=Right(TString,InStr(1,TString,"",1))+0'提取表示星期的数字WeekDayToDate=FirstM+(WeekD-1)*7'将星期数乘以7并累加到之前获得的日期中EndFunction在如图3-14所示的工作表中，区域A1:A3中包含了不同日期的星期表示，在单元格B1中输入下面的公式：WeekDayToDate(A1)将此公式向下拖动复制到单元格B3，这样会得到将以星期表示的日期格式转换为普通46人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇日期格式后的结果。图3-14将星期数转换为对应的日期3.3.5从文本中提取数字如果单元格中既包含文本又包含数字，那么可以使用下面的自定义函数。其中，参数AllText为要提取数字的文本：FunctionGetNumbersFromText(AllTextAsString)DimiAsInteger,jAsIntegerDimNumsAsStringFori=Len(AllText)To1Step-1'定义循环的计算器变量取值范围IfIsNumeric(Mid(AllText,i,1))Then'检测文本中每一个字符是否为数字j=j+1Nums=Mid(AllText,i,1)&Nums'如果检测字符为数字，那么从原字符串中提取该字符并进行拼接EndIfIfj=1ThenNums=CInt(Mid(Nums,1,1))NextiGetNumbersFromText=CLng(Nums)EndFunction在如图3-15所示的工作表中，在单元格B1和B2中使用自定义函数GetNumbersFromText，将分别提取出单元格A1和A2中的数字。图3-15从文本中提取数字3.3.6在区域内搜索特定的文本下面的自定义函数可以根据您指定的字符来搜索它存在于哪个单元格中，如果在区域中的多个单元格都包含指定的字符，那么将显示这些单元格引用，它们之间以逗号分隔。47人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇其中，参数MyRange代表要搜索的区域，FindString代表要搜索的字符：FunctionFindStringInText(MyRangeAsRange,FindStringAsString)DimTAsStringDimCellAsRangeForEachCellInMyRange'遍历区域中的每一个单元格IfInStr(Cell.Text,FindString)>0Then'判断要查找的内容是否出现在区域中IfLen(T)=0Then'检测中间变量的字符串T长度是否为0T=Cell.Address(False,False)'将单元格的相对引用地址赋给变量TElseT=T&","&Cell.Address(False,False)'当变量T不为0后，将每次获得的单元格地址与上一次进行拼接，之间用逗号分隔EndIfEndIfNextCellFindStringInText=T'将最终的变量T的结果赋给函数EndFunction在如图3-16所示的工作表中，单元格区域A1:A4包含了要查找的内容，而在单元格B1中使用自定义函数FindStringInText，来查找区域A1:A4中包含有“Excel”的单元格，并将查找结果显示在单元格B1中。对于图3-16来说，搜索的结果说明了单元格A1、A2、A3中都包含了字符串“Excel”。图3-16在指定区域内搜素特定的文本3.3.7将金额转换为中文大写在财务工作中，通常需要将阿拉伯数字形式的金额转换为中文大写形式。如果多层嵌套的IF函数固然可以完成这项工作，但是公式很长，输入起来容易出错。可以通过创建一个自定义函数，将阿拉伯金额转换为中文大写形式。下面的函数即可完成金额转换功能，其中，Money代表要转换的阿拉伯数字形式的金额：FunctionNumToCapsMoney(MoneyAsString)DimxAsString,yAsString48人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇DimiAsIntegerConstzimu=".sbqwsbqysbqwsbq"'定义位置代码Constletter="0123456789sbqwy.zjf"'定义汉字缩写ConstCaseWord="零壹贰叁肆伍陆柒捌玖拾佰仟萬億元整角分"'定义大写汉字DimtempAsStringtemp=MoneyIfInStr(temp,".")>0Thentemp=Left(temp,InStr(temp,".")-1)IfLen(temp)>16ThenMsgBox"数目太大，无法换算！请输入一亿亿以下的数字",64,"错误提示":ExitFunction'只能转换一亿亿元以下数目的货币！x=Format(Money,"0.00")'格式化货币y=""Fori=1ToLen(x)-3y=y&Mid(x,i,1)&Mid(zimu,Len(x)-2-i,1)NextiIfRight(x,3)=".00"Theny=y&"z"Elsey=y&Left(Right(x,2),1)&"j"&Right(x,1)&"f"EndIfy=Replace(y,"0q","0")'避免零千(如：40700肆萬零千零柒佰)y=Replace(y,"0b","0")'避免零百(如：47000肆萬柒千零佰)y=Replace(y,"0s","0")'避免零十(如：207贰佰零拾零柒)DoWhiley<>Replace(y,"00","0")y=Replace(y,"00","0")'避免双零(如：2006壹仟零零陆)Loopy=Replace(y,"0y","y")'避免零億(如：120億壹佰贰十零億)y=Replace(y,"0w","w")'避免零萬(如：120萬壹佰贰十零萬)y=IIf(Len(x)=5AndLeft(y,1)="1",Right(y,Len(y)-1),y)'避免壹十(如：16壹拾陆；10壹拾)y=IIf(Len(x)=4,Replace(y,"0.",""),Replace(y,"0.","."))'避免零元(如：70.00柒拾零圆；0.17零圆柒角贰分)Fori=1To19y=Replace(y,Mid(letter,i,1),Mid(CaseWord,i,1))'大写汉字NextiNumToCapsMoney=yEndFunction49人民邮电出版社《Excel公式与函数大辞典》配套光盘附赠电子书——Excel2013VBA篇在如图3-17所示的工作表中，单元格A1中包含了阿拉伯数字格式的金额，在单元格B1中使用自定义函数NumToCapsMoney将单元格A1中的阿拉伯数字，自动转换为中文大写形式，并在单元格B1中显示转化后的结果。图3-17将阿拉伯形式的金额转换为中文大写形式50