VBA函数定义及说明

函数定义

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