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
    评论
目录: 1.返回 Column 英文字 2.查询某一值第num次出现的值 3.返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额 4.从形如"123545ABCDE"的字符串取出数字 5.从形如"ABCD12455EDF"的字符串取出数字 6.按SplitType取得RangeName串值的起始位置 7.将金额数字转成文大写 8.计算某种税金 9.人民币大、小写转换 10.查汉字区位码 11.把公元年转为农历 12.返回指定列数的列标 13.用指定字符替换某字符 14.从右边开始查找指定字符在字符串的位置 15.从右边开始查找指定字符在字符串的位置 16.计算工龄 17.计算日期差,除去星期六、星期日 18.将英文字反转的自定函数 19.计算个人所得税 20.一个能计算是否有重复单元的函数 21.数字金额转文大写 22.将数字转成英文 23.人民币大小写转换 24.获取区域颜色值 25.获取活动工作表名 26.获取最后一行行数 27.判断是否连接在线 28.币种转换 29.检验工作表是否有可打印内容 30.查找一字符串(withinstr)在另一字符串(findstr1)某一次(startnum)出现时的位置,返回零表示没找到。 31.增加文件路径最后的“\”符号 32.计算所得税 33.从工作表第一行的标题文字以数字形式返回所在列号 34.在多个工作表查找一个范围内符合某个指定条件的项目对应指定范围加总求和 35.返回 Column 英文字 36.查找指定列名的列数 37.文字格式的时间(分:秒)转化为数字格式(秒) 38.将"hh:mm:ss"格式的时分秒数转换成秒数 39.金额文大写转数字 40.把角度转为度秒分、弧度等显示 41.身份证号码侦测 42.显示公式 43.方便财务人员理帐查找 44.数值转换为字符地址 45.字符地址转换为数值 46.等待时间(以秒计算) 47.得到字符串实际的长度(以单字节记) 48.18位身份证最后一位有效性验证 49.计算符合maturity condition的拆解金额 50.对多个用同一分隔符分隔的待查找元素,逐一在表区域首列内搜索,将返回选定单元格的值相加,相当于多个vlookup函数相加,对于查找不到的元素在批注添加,以提醒用户。 51.根据个人所得税(工资)反算工资数 52.判断表是否存在 53.角度转弧 54.比较相同的字符串 55.对选定的数组进行排序 56.取得指定月份天数 57.排序工作表活页薄 58.统计数组非重复数据个数 59.摘取子字符串 60.计算20000余个汉字的笔画 61.删除当前工作表的全部超连接 62.取得相近数据 63.提取定串汉字 64.搜索重复数据(选定范围) 65.字符型转数字型 66.小写人民币转大写人民币 67.取得指定月份人星期天个数 68.侦测档案是否包含宏 69.获取循环参照单元格 70.创建桌面快捷方式 71.自动建立多级目录 72.统计经筛选后符合条件的记录条数 73.复制单元格列高与栏宽 74.取消隐藏工作表(包括vba Project工程保护的) 75.删除单元格自定义名称 76.从文件路径取得文件名 77.取得一个文件的扩展名 78.取得一个文件的路径 79.十进制转二进制 80.检查一个数组是否为空 81.字母栏名转数字栏名 82.数字栏名转文字栏名 83.判断一件活页夹是否还有子目录 84.判断一个文件是否在使用 85.列出档案详细摘要信息 86.获取菜单ID编号及名称列表 87.状态列动态显示文字 88.取得一个文件的路径2 89.取得一个文件的路径3 90.取得Activecell的栏名 91.取得单元格指定字符前的字符 92.前单元格指定字符前的字符颜色改成红色 93.根据数字返回对应的字母列号 94.取工作表名字 95.取消所有隐藏的宏表 96.导出VBA Project代码 97.导入VBA Project代码 98.取得汉字拼音的第一个字母 99.获取两栏相同的数据 100.选取当前工作表公式出错的单元格﹐关返回出错个数 101.将工作表最后一列作为页脚打印在每一面页尾 102.获取vbproject引用项目 103.移除Excel工作表的外部数据连接 104.将选择定单元格作成镜像图片 105.反选择单元格的数 106.在Excel加入一个量度尺(以厘米为单位) 107.在Excel加入一个量度尺(以寸为单位) 108.取得一个短文件名的长文件名 109.取得临时文件名 110.等用Shell调用的程序执行完成后再执行其它程序 111.将Mouse显示成动画 112.限制Mouse移动范围 113.取得当前激活窗品句柄及标题 114.取得屏幕分辨率 115.自动建立多级目录 116.将文件长度置零 117.读取WIN9X / Me共享文件夹密码 118.取得预设的打印机及设置预设的打印机 119.获得当前操作系统的打印机个数及检测打印是否存在 120.枚举打印机名称清单 121.读取网络服务器当前时间 122.下载文件到指定目录 123.自动映射网络驱动器 124.自动断开网络驱动器 125.连接选定单元格的内容 126.获取一个单元格有指定字体颜色部份数据 127.对指定文件加XLS加密 128.选择指定范围内使用了填充颜色的单元格 129.在特定的区域内查找文本,返回值是包含查找文本的单元格 130.返回特定区域最大值的地址 131.删除表格使用范围内的所有空白单元格 132.返回数组有多少个指定的字符串 133.返回当前工作表引用了指定的单元的地址 134.获取Excel字型列表 135.获取一个字符串有多少个数字字符 136.在Excel对多列进行填充 137.对选定的范围进行数据填充(忽略单元格格式) 138.VBA Project加密及解密 139.列出收藏夹的网址 140.计算两个日期之间相隔的年份,比如年龄,工龄等.可计算从1000年01月01日起的日期 141.从字符串提取纯数字 142.将一个数组按升序排列 143.将一个数组按降序排列 144.删除空白列 145.判断工作表是否为空白 146.将数据按类分到不同工作薄 147.单元格内数据排序 148.对多栏排序 149.返回计算公式的值 [,值的计算公式] 150.把第一列=某个值对应的第二列的内容连在一起,并用、隔开 151.取得系统使用模式 152.计算机注销/关机/重启 153.更改计算机名称 154.从n位开始取出字符串的汉字、英文字母、数字 155.在指定列寻找含有指定字符串的单元格,并将符合条件的单元格标为红色,并将对应的下一列单元格赋值为1 156.清除字符串的空格 157.查找合并单元格位置 158.阴阳历转换和阴阳历生日 159.利用数组和Substitute来替换某字符 160.一键创建斜线表头 161.自动获取指定月的工作日

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 4
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

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

抵扣说明:

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

余额充值