vba中function(自定义函数)

'自定义函数:顾名思义,就是自己定义的函数。
'为什么使用自定义函数:exce内置了很多有用的函数。但仍无法满足工作需求。
'自定义函数的作用:简化复杂的公式。可以和工作表函数相互嵌套使用
'
'
' Function 函数名(参数1,参数2....)
'   代码
'   函数名=代码执行的结果
' End Function
    
'

'1.函数名称可能有函数,也可以像now,today,rand等函数一样不需要任何参数
Public Function stname()
stname = ActiveSheet.Name '返回当前工作表名
End Function


Public Function wbname()
wbname = ThisWorkbook.Name '返回工作簿名
End Function

'有参数的自定义函数
Function nas(num As Integer) '提取工作表名或工作簿名
    If num = 0 Then
        nas = ActiveSheet.Name
    ElseIf num = 1 Then
        nas = ThisWorkbook.Name
    End If
End Function


'1.自定义工作函数的调用

Function wbname()
wbname = ActiveWorkbook.Name
End Function


Function wbnames()
i = InStr(wbname, ".xls") '调用自定义的工作表函数,找到.xls所在的位置
j = Left(wbname, i - 1) '调用自定义的工作表函数
wbnames = j
End Function

'2.自定义工作表函数的编写与运用范围
'
'自定义工作表函数的代码只能编写在:标准模块中,不能在工作表中或thisworkbook中
'到目前为止我们编写的自定义函数只能在当前工作簿运行。要在所有工作簿中运行则:
'A.将编写在标准模块中的自定义函数代码保存为:加载宏。
'B.将加载的宏保持运用即可
'
'提示:与应用程序事件程序的操作方法相似
 

案例:

 

参数不定的自定义函数:

 参数值默认和参数缺省:

案例:返回不重复随机数(结果是数组)

Function sjs(最小值 As Integer, 最大值 As Integer, 所需个数 As Integer)
Application.Volatile
Set d = CreateObject("scripting.dictionary")
Do
    i = Application.RandBetween(最小值, 最大值)
    d(i) = ""
Loop Until d.Count = 所需个数
    sjs = d.keys
End Function

Sub dd()
Set d = CreateObject("scripting.dictionary")
Do
    i = Application.RandBetween(1, 9)
    d(i) = ""
Loop Until d.Count = 4
    sj = d.keys
End Sub


案例2:

Function celljoin(区域 As Range, Optional 合并符 As String = "-")
arr = Application.Transpose(Application.Transpose(区域))
celljoin = Join(arr, 合并符)
End Function

 

Function 去除(rng As Range, Optional shuzi As Integer = 2)
Set regx = CreateObject("vbscript.regexp")
With regx
        .Global = True
    If shuzi = 0 Then
        .Pattern = "\d" '去数字
    ElseIf shuzi = 1 Then
        .Pattern = "[a-zA-Z]" '去字母
    ElseIf shuzi = 2 Then
        .Pattern = "[一-龢]" '去汉字
    End If
        去除 = .Replace(rng, "")
End With
End Function


 

案例3:

Function jia(ParamArray num())
For Each n In num
    m = m + n
Next
    jia = m
End Function

Function joins(ParamArray arr())
For Each ar In arr
    For Each a In ar
    txt = txt & a.Value
    Next
Next
joins = txt
End Function
'注意:
'1.如果参数不定,那么不能指定参数的数据类型
'2.如果有不定参数,不定参数一定要写在最后。
'


案例3:

Function 身份证(rng As Range, Optional 提取内容 As String = "年龄")
If 提取内容 = "年龄" Then
身份证 = Year(Now()) - (19 & Mid(rng, Len(rng) / 2, 2))
ElseIf 提取内容 = "性别" Then
身份证 = IIf(Mid(rng, 15, 3) Mod 2, "男", "女")
End If
End Function

下图用excel:


 案例4:单元颜色求和(字典+自定义函数)

Function COLORSUM(单元格区域 As range, 汇总的颜色 As range)
Set d = CreateObject("Scripting.Dictionary")
For Each Rng In 汇总的颜色
    d(Rng.Interior.ColorIndex) = ""
Next
For Each ci In d.keys
    For Each Rng In 单元格区域
        If Rng.Interior.ColorIndex = ci Then
            r = r + Rng.Value
        End If
    Next
    Next
COLORSUM = r
End Function


Sub test()
Set d = CreateObject("Scripting.Dictionary")
Set 区域 = Application.InputBox("区域选择", , , , , , , 8)
Set 颜色 = Application.InputBox("颜色选择", , , , , , , 8)
For Each Rng In 颜色
    d(Rng.Interior.ColorIndex) = ""
Next
For Each ci In d.keys
    For Each Rng In 区域
        If Rng.Interior.ColorIndex = ci Then
            r = r + Rng.Value
        End If
    Next
    Next
MsgBox r

 

 

 

 

End Sub


案例5:反转字符与数字求和

Function DD(rng As Range) '反转字符
For i = Len(rng) To 1 Step -1
    a = Mid(rng, i, 1)
    b = b & a
Next
    DD = b
End Function

(解释:)

 


Function 求和(rng As Range, Optional s As String = "")
Application.Volatile
 Set regx = CreateObject("vbscript.regexp")
With regx
    .Global = True
    .Pattern = "\d" & s
   Set mat = .Execute(rng)
End With
For Each m In mat
n = n + m * 1
Next
求和 = n
End Function

 解释:关于Application.Volatile易失性函数看下面链接

易失性函数Volatile | Excel VBAhttp://xixiacademy.com/html/ExcelVBA/Function/ExcelVBA_VolatileFunction.html


案例5:提取不重复值

 

Function 不重复值(rng As Range)
Set d = CreateObject("scripting.dictionary")
For Each rn In rng
    d(rn.Value) = ""
Next
不重复值 = d.keys
End Function


Function 不重复2(rng As Range, Optional num As Integer = 0)
Set d = CreateObject("scripting.dictionary")
Set regx = CreateObject("vbscript.regexp")
With regx
        .Global = True
    If num = 0 Then
        .Pattern = ".+" '所有值的不重复
    ElseIf num = 1 Then
        .Pattern = "[一-龢]+" '汉字不重复
    ElseIf num = 2 Then
        .Pattern = "[a-zA-Z]+" '字母不重复
    ElseIf num = 3 Then
        .Pattern = "\d+" '数字不重复
    End If
For Each rn In rng
    For Each m In .Execute(rn)
        d(m.Value) = ""
    Next
Next
不重复2 = d.keys
End With
End Function

 


ps:如果上面看懂了,下面就不用看了,不然看的头疼! 

ByVal是值传递,ByRef是地址传递

回顾11章中的内容:

ByVal是值传递,ByRef是地址传递

 

好了,参数讲完,回归,function用法:

  • 8
    点赞
  • 82
    收藏
    觉得还不错? 一键收藏
  • 4
    评论
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值