VBA函数定义及说明

admin管理员组

文章数量:1794759

VBA函数定义及说明

文章目录

• 函数定义
• 传值和传引用
• 函数返回对象
• 使用默认参数
• 使用不定长参数
• 一些函数示例
• • text_split：字符串分割
  • file_exists：判断文件是否存在
  • basename：路径提取文件名
  • sheet_exists：工作表是否存在
  • workbook_is_open:工作表是否存在
  • text_join：split的反函数
  • ifs：多判断
  • range_workbook_name：返回单元格所在的工作簿名称
  • text_speak：说出文本
  • is_like：模式匹配

函数定义

VBA定义的函数可以在工作表使用，如果是在加载插件中定义函数，本机所有打开工作簿都可以使用该函数，当然可以在过程sub中调用函数；

VBA函数与sub过程不同的是，函数有返回内容；过程和函数都可以传入参数。 函数使用Function关键字定义，定义规则如下： Function 函数名称(形参及类型) 函数主体 函数名称= 函数返回 End Function 示例：

'定义一个数值平方的函数，形参：a，形参a类型：long，函数返回：a ^ 2；函数名称：test Function test(a as long) test = a ^ 2 End Function '定义全局函数,使用public关键字，这个关键字跟变量定义是一致的。后面跟的as long是返回类型 Public Function test(a as long) as long test = a ^ 2 End Function 传值和传引用

函数或方法传值使用关键字ByVal，传引用使用关键字ByRef

Sub num_print() Dim i, num As Long ' 定义一个变量 num = 0 For i = 1 To 10 s = add(num) ' 调用add函数s Debug.Print num ' 函数参数是传引用，会依次打印1,2,3,,,,10 Next End Sub Function add(ByRef a As Variant) a = a + 1 End Function

如果上述函数参数为传值ByVal，则函数不影响方法num_print中变量num的改变，全打印0；

函数返回对象

函数也可以返回对象，返回对象要使用set关键字； 示例：返回字典

Function aa() Dim d As Object Set d = CreateObject("scripting.dictionary") today = Date the_month_date = CDate(Year(Date) & "-" & Month(Date) & "-" & 20) '这个月的20号 last_month_date = Application.WorksheetFunction.EDate(the_month_date, -1) '上个月的20号 d("today") = today d("the_month_date") = the_month_date d("last_month_date") = last_month_date d("the_month") = Month(last_month_date) '这个月 d("last_month") =Month(Date) '上个月 Set aa = d '返回对象使用set关键字 End Function '函数调用 sub test1() dim d1 as object set d1 = aa() debug.print d1("today") '打印字典键today对应的值 end sub 使用默认参数

函数传入参数格式：形参 as 参数类型 = 参数默认值 示例：正则提取函数

Function regexp(rg As Variant, str As String, Optional mat As Byte = 0, Optional group As Variant = Empty) 'Optional表示参数不是必需的关键字。如果使用了该选项，则参数表中该参数后的参数都必须是可选的，而且必须都使用 Optional 关键字声明。 Dim re As Object Set re = CreateObject("vbscript.regexp") With re .Global = True .Pattern = str If re.test(rg) Then If group = Empty Then regexp = re.Execute(rg)(mat) Else regexp = re.Execute(rg)(mat).submatches(group) End If End If End With Set re = Nothing End Function 使用不定长参数

形参及类型固定写法：ParamArray 参数名称() As Variant（必须放在参数最后面） 示例：只要有一个单元格为空，返回空字符串

Function if_blank(goal_rg As Variant, ParamArray rngs() As Variant) Dim rg For Each rg In rngs If rg.Value = "" Then if_blank = "" Exit Function End If Next if_blank = goal_rg End Function

示例：单元格求和sum

Function rng_sum(ParamArray values() As Variant) Dim result As Variant Dim val0 As Variant ' for循环里的变量必须是变体型变量，否则会报错 result = 0 For Each val0 In values For Each val1 In val0 result = result + val1 Next Next rng_sum = result End Function '然后我们在工作表里写了这么一个函数 =rng_sum(K21:L21,M22:N22,L23:N23) 一些函数示例 text_split：字符串分割

EXCEL里面没有split函数，可以使用vba定义该函数，在工作表内使用

Function text_split(str As String, sep As String, index As Long) ' 参数：str:被分割的字符串,sep:分隔符,index:分割后返回数组该索引的值，如果小于0返回数组 ' 样例：text_split("abc,de,fg",",")(1) 返回：de If index >= 0 Then text_split = Split(str, sep)(index) Else text_split = Split(str, sep) End If End Function file_exists：判断文件是否存在

判断文件是否存在，dir函数可以使用通配符：*

Function file_exists(full_name As String) As Boolean file_exists = (Dir(full_name) <> "") End Function basename：路径提取文件名

传入一个带路径完整的文件名，返回文件名，比如：test.xlsx

Function basename(full_name) ' Application.PathSeparator：反斜杠 ' basename("d:/filedir/text.xlsx")，返回：text.xlsx Dim arr As Variant arr = Split(full_name, Application.PathSeparator) basename = arr(UBound(arr)) End Function sheet_exists：工作表是否存在 Function sheet_exists(sheet_name As Variant) As Boolean ' 传入工作表名称，返回是否存在：boolean ' sheet_exists("工作表2") Dim st As Object On Error Resume Next Set st = ActiveWorkbook.Sheets(sheet_name) If Err.Number = 0 Then ' 如果没有报错，返回true sheet_exists = True Else sheet_exists = False End If workbook_is_open:工作表是否存在 Function workbook_is_open(wb_name As Variant) As Boolean ' 传入工作簿名称，返回是否打开：boolean ' sheet_exists("工作表2") Dim st As Object On Error Resume Next Set st = Workbooks(wb_name) If Err.Number = 0 Then ' 如果没有报错，返回true workbook_is_open = True Else workbook_is_open = False End If text_join：split的反函数

该函数在Excel2019版已经引入，早期的版本可以通过自定义函数实现

Function text_join(sep As String, is_skip_blank As Boolean, ParamArray ranges() As Variant) ' sep：分隔符，is_skip_blank:是否跳过空值，ranges：数组 Dim rngs, sub_rng As Variant Dim s As String s = "" For Each rngs In ranges For Each sub_rng In rngs If is_skip_blank = True Then ' 是否跳过空格 If Len(sub_rng) > 0 Then s = s & sep & Rng End If Else s = s & sep & Rng End If Next Next text_join = Replace(s, sep, "", 1, 1) ' 把开头的分隔符去掉 End Function ifs：多判断

该函数在excel2019版本后才有，早期的版本可以在vba中定制；无须重复if嵌套

Function udf_ifs(ParamArray args() As Variant) Dim i As Byte Dim args_len As Byte args_len = UBound(args) ' 参数索引下标从0开始 If args_len < 1 Then Exit Function For i = 0 To UBound(args) Step 2 If args(i) = True Then udf_ifs = args(i + 1) ' 如果参数是true，返回后面一个参数值 Exit Function End If Next ' 如果都没有是，参数个数是基数，返回最后一个参数 If args_len Mod 2 = 0 Then udf_ifs = args(args_len): Exit Function udf_ifs = "#N/A" ' 参数是偶数，且没有true对象，返回错误值 End Function range_workbook_name：返回单元格所在的工作簿名称

返回单元格所在工作簿的名称，parent表示父对象，比如单元格的父对象是工作表，工作表的父对象是工作簿，这里调用了两次

Function range_workbook_name(rng As Variant) As String range_workbook_name = rng.Parent.Parent.Name End Function text_speak：说出文本

使用的是Excel的文本转化成语音的转化生成器，讲述传入的字符串

Function text_speak(text) ' Application.Speech.Speak ("hello alice") Application.Speech.Speak (text) text_speak = text End Function is_like：模式匹配

使用vba的like函数，类似于sql中的like，like中pattern参数的字符

pattern字符解释

？	任意单个字符
*	0个或多个字符
#	任意单个数字（0-9）
[charlist]	字符列表中的任意单个字符
[!charlist]	不在字符列表中的任意单个字符

Function is_like(str As String, pattern As String) As Boolean is_like = str Like pat End Function

本文标签： 函数定义VBA