文章目录
- 函数定义
- 传值和传引用
- 函数返回对象
- 使用默认参数
- 使用不定长参数
- 一些函数示例
- 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函数定义及说明
发布评论