excel161个VBA自定义函数大全

1、VBA自定义函数大全目录TOC o 1-2 h u HYPERLINK l _Toc23490 1.函数作用：返回 Column 英文字 PAGEREF _Toc23490 5 HYPERLINK l _Toc25070 2.函数作用：查询某一值第num次出现的值 PAGEREF _Toc25070 5 HYPERLINK l _Toc14911 3.函数作用：返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额 PAGEREF _Toc14911 6 HYPERLINK l _Toc22651 4.函数作用：从形如123545ABCDE的字符串中取出数字 PAGERE

2、F _Toc22651 7 HYPERLINK l _Toc4399 5.函数作用：从形如ABCD12455EDF的字符串中取出数字 PAGEREF _Toc4399 7 HYPERLINK l _Toc21003 6.函数作用：按SplitType取得RangeName串值中的起始位置 PAGEREF _Toc21003 8 HYPERLINK l _Toc7930 7.函数作用:将金额数字转成中文大写 PAGEREF _Toc7930 9 HYPERLINK l _Toc22610 8.函数作用:计算某种税金 PAGEREF _Toc22610 14 HYPERLINK l _Toc814

3、3 9.函数作用:人民币大、小写转换 PAGEREF _Toc8143 14 HYPERLINK l _Toc13055 10.函数作用:查汉字区位码 PAGEREF _Toc13055 16 HYPERLINK l _Toc12268 11.函数作用:把公元年转为农历 PAGEREF _Toc12268 17 HYPERLINK l _Toc31580 12.函数作用:返回指定列数的列标 PAGEREF _Toc31580 38 HYPERLINK l _Toc24917 13.函数作用:用指定字符替换某字符 PAGEREF _Toc24917 39 HYPERLINK l _Toc2706

4、5 14.函数作用:从右边开始查找指定字符在字符串中的位置 PAGEREF _Toc27065 39 HYPERLINK l _Toc10258 15.函数作用:从右边开始查找指定字符在字符串中的位置 PAGEREF _Toc10258 40 HYPERLINK l _Toc4908 16.函数作用:计算工龄 PAGEREF _Toc4908 40 HYPERLINK l _Toc6494 17.函数作用:计算日期差，除去星期六、星期日 PAGEREF _Toc6494 41 HYPERLINK l _Toc17018 18.函数作用:将英文字反转的自定函数. PAGEREF _Toc1701

5、8 42 HYPERLINK l _Toc7549 19.函数作用:计算个人所得税 PAGEREF _Toc7549 42 HYPERLINK l _Toc11556 20.函数作用:一个能计算是否有重复单元的函数 PAGEREF _Toc11556 43 HYPERLINK l _Toc28941 21.数字金额转中文大写 PAGEREF _Toc28941 44 HYPERLINK l _Toc3558 22.函数作用:将数字转成英文 PAGEREF _Toc3558 45 HYPERLINK l _Toc31245 23.函数作用:人民币大小写转换 PAGEREF _Toc31245 4

6、8 HYPERLINK l _Toc14384 24.函数作用:获取区域颜色值 PAGEREF _Toc14384 49 HYPERLINK l _Toc22002 25.函数作用:获取活开工作表名 PAGEREF _Toc22002 49 HYPERLINK l _Toc5212 26.函数作用:获取最后一行行数 PAGEREF _Toc5212 49 HYPERLINK l _Toc29053 27.函数作用:判断是否连接在线 PAGEREF _Toc29053 50 HYPERLINK l _Toc12980 28.函数作用:币种转换 PAGEREF _Toc12980 50 HYPER

7、LINK l _Toc16433 29.函数作用:检验工作表是否有可打印内容 PAGEREF _Toc16433 51 HYPERLINK l _Toc21379 30.函数作用:查找一字符串(withinstr)在另一字符串中(findstr1)中某一次(startnum)出现时的位置，返回零表示没找到。 PAGEREF _Toc21379 53 HYPERLINK l _Toc6303 31.函数作用:增加文件路径最后的“符号 PAGEREF _Toc6303 54 HYPERLINK l _Toc29890 32.函数作用:计算所得税 PAGEREF _Toc29890 54 HYPER

8、LINK l _Toc9184 33.函数作用:从工作表第一行的标题文字以数字形式返回所在列号 PAGEREF _Toc9184 54 HYPERLINK l _Toc14885 34.函数作用:在多个工作表中查找一个范围内符合某个指定条件的工程对应指定范围加总求和 PAGEREF _Toc14885 55 HYPERLINK l _Toc489 35.函数作用:返回 Column 英文字 PAGEREF _Toc489 56 HYPERLINK l _Toc27281 36.函数作用:查找指定列名的列数 PAGEREF _Toc27281 56 HYPERLINK l _Toc4528 37

9、.函数作用:文字格式的时间(分:秒)转化为数字格式(秒) PAGEREF _Toc4528 57 HYPERLINK l _Toc22081 38.函数作用:将hh:mm:ss格式的时分秒数转换成秒数 PAGEREF _Toc22081 57 HYPERLINK l _Toc817 39.函数作用:金额中文大写转数字 PAGEREF _Toc817 58 HYPERLINK l _Toc21290 40.函数作用:把角度转为度秒分、弧度等显示 PAGEREF _Toc21290 59 HYPERLINK l _Toc19152 41.函数作用:身份证号码侦测 PAGEREF _Toc19152

10、 60 HYPERLINK l _Toc10587 42.函数作用:显示公式 PAGEREF _Toc10587 61 HYPERLINK l _Toc2229 43.函数作用:方便财务人员理帐查找 PAGEREF _Toc2229 62 HYPERLINK l _Toc22373 44.函数作用:数值转换为字符地址 PAGEREF _Toc22373 64 HYPERLINK l _Toc19470 45.函数作用:字符地址转换为数值 PAGEREF _Toc19470 65 HYPERLINK l _Toc5911 46.函数作用:等待时间以秒计算 PAGEREF _Toc5911 65

11、HYPERLINK l _Toc3348 47.函数作用:得到字符串实际的长度以单字节记 PAGEREF _Toc3348 66 HYPERLINK l _Toc5184 48.函数作用:18位身份证最后一位有效性验证 PAGEREF _Toc5184 66 HYPERLINK l _Toc8710 49.函数作用:计算符合maturity condition的拆解金额 PAGEREF _Toc8710 67 HYPERLINK l _Toc28742 50.函数作用:对多个用同一分隔符分隔的待查找元素，逐一在表区域首列内搜索，将返回选定单元格的值相加， PAGEREF _Toc28742 6

12、8 HYPERLINK l _Toc14974 51.函数作用:根据个人所得税工资反算工资数 PAGEREF _Toc14974 69 HYPERLINK l _Toc10722 52.函数作用:判断表是否存在 PAGEREF _Toc10722 70 HYPERLINK l _Toc27328 53.函数作用:角度转弧 PAGEREF _Toc27328 70 HYPERLINK l _Toc20343 54.函数作用:比拟相同的字符串 PAGEREF _Toc20343 71 HYPERLINK l _Toc28175 55.函数作用:对选定的数组进行排序 PAGEREF _Toc2817

13、5 71 HYPERLINK l _Toc9216 56.函数作用:取得指定月份天数 PAGEREF _Toc9216 73 HYPERLINK l _Toc9523 57.函数作用:排序工作表活页薄 PAGEREF _Toc9523 73 HYPERLINK l _Toc28662 58.函数作用:统计数组中非重复数据个数 PAGEREF _Toc28662 74 HYPERLINK l _Toc15949 59.函数作用:摘取子字符串 PAGEREF _Toc15949 74 HYPERLINK l _Toc14935 60.函数作用:计算20000余个汉字的笔画 PAGEREF _Toc

14、14935 75 HYPERLINK l _Toc30778 61.函数作用:删除当前工作表中的全部超连接 PAGEREF _Toc30778 76 HYPERLINK l _Toc13056 62.函数作用:取得相近数据 PAGEREF _Toc13056 76 HYPERLINK l _Toc17934 63.函数作用:提取定串中汉字 PAGEREF _Toc17934 77 HYPERLINK l _Toc8375 64.函数作用:搜索重复数据(选定范围) PAGEREF _Toc8375 77 HYPERLINK l _Toc31602 65.函数作用:字符型转数字型 PAGEREF

15、_Toc31602 78 HYPERLINK l _Toc30867 66.函数作用:小写人民币转大写人民币 PAGEREF _Toc30867 78 HYPERLINK l _Toc12520 67.函数作用:取得指定月份人星期天个数 PAGEREF _Toc12520 79 HYPERLINK l _Toc12715 68.函数作用:侦测档案是否包含宏 PAGEREF _Toc12715 80 HYPERLINK l _Toc18249 69.函数作用:获取循环参照单元格 PAGEREF _Toc18249 81 HYPERLINK l _Toc16176 70.函数作用:创立桌面快捷方式

16、 PAGEREF _Toc16176 81 HYPERLINK l _Toc27626 71.函数作用:自动建立多级目录 PAGEREF _Toc27626 82 HYPERLINK l _Toc11356 72.函数作用:统计经筛选后符合条件的记录条数 PAGEREF _Toc11356 83 HYPERLINK l _Toc19287 73.函数作用:复制单元格列高与栏宽 PAGEREF _Toc19287 83 HYPERLINK l _Toc28896 74.函数作用:取消隐藏工作表包括vba Project工程保护的) PAGEREF _Toc28896 84 HYPERLINK l

17、 _Toc20215 75.函数作用:删除单元格自定义名称 PAGEREF _Toc20215 84 HYPERLINK l _Toc2483 76.函数作用:从文件路径中取得文件名 PAGEREF _Toc2483 84 HYPERLINK l _Toc24306 77.函数作用:取得一个文件的扩展名 PAGEREF _Toc24306 85 HYPERLINK l _Toc373 78.函数作用:取得一个文件的路径 PAGEREF _Toc373 85 HYPERLINK l _Toc20445 79.函数作用:十进制转二进制 PAGEREF _Toc20445 86 HYPERLINK

18、l _Toc11454 80.函数作用:检查一个数组是否为空 PAGEREF _Toc11454 86 HYPERLINK l _Toc16380 81.函数作用:字母栏名转数字栏名 PAGEREF _Toc16380 87 HYPERLINK l _Toc16914 82.函数作用:数字栏名转文字栏名 PAGEREF _Toc16914 87 HYPERLINK l _Toc7182 83.函数作用:判断一件活页夹中是否还有子目录 PAGEREF _Toc7182 87 HYPERLINK l _Toc29269 84.函数作用:判断一个文件是否在使用中 PAGEREF _Toc29269

19、88 HYPERLINK l _Toc29696 85.函数作用:列出档案详细摘要信息 PAGEREF _Toc29696 88 HYPERLINK l _Toc3565 86.函数作用:获取菜单ID编号及名称列表 PAGEREF _Toc3565 89 HYPERLINK l _Toc7689 87.函数作用:状态列动态显示文字 PAGEREF _Toc7689 90 HYPERLINK l _Toc25597 88.函数作用:取得一个文件的路径2 PAGEREF _Toc25597 90 HYPERLINK l _Toc16253 89.函数作用:取得一个文件的路径3 PAGEREF _T

20、oc16253 90 HYPERLINK l _Toc13396 90.函数作用:取得Activecell的栏名 PAGEREF _Toc13396 91 HYPERLINK l _Toc20855 91.函数作用:取得单元格中指定字符前的字符 PAGEREF _Toc20855 91 HYPERLINK l _Toc4620 92.函数作用:前单元格指定字符前的字符颜色改成红色 PAGEREF _Toc4620 91 HYPERLINK l _Toc10114 93.函数作用:根据数字返回对应的字母列号 PAGEREF _Toc10114 92 HYPERLINK l _Toc17390 9

21、4.函数作用:取工作表名字 PAGEREF _Toc17390 92 HYPERLINK l _Toc28911 95.函数作用:取消所有隐藏的宏表 PAGEREF _Toc28911 92 HYPERLINK l _Toc22798 96.函数作用:导出VBA Project代码 PAGEREF _Toc22798 93 HYPERLINK l _Toc12667 97.函数作用:导入VBA Project代码 PAGEREF _Toc12667 93 HYPERLINK l _Toc6980 98.函数作用:取得汉字拼音的第一个字母 PAGEREF _Toc6980 93 HYPERLIN

22、K l _Toc21610 99.函数作用:获取两栏中相同的数据 PAGEREF _Toc21610 96 HYPERLINK l _Toc5736 100.函数作用:选取当前工作表中公式出错的单元格关返回出错个数 PAGEREF _Toc5736 97 HYPERLINK l _Toc21835 101.函数作用:将工作表中最后一列作为页脚打印在每一面页尾 PAGEREF _Toc21835 97 HYPERLINK l _Toc25215 102.函数作用:获取vbproject引用工程 PAGEREF _Toc25215 98 HYPERLINK l _Toc5112 103.函数作用:

23、移除Excel工作表中的外部数据连接 PAGEREF _Toc5112 98 HYPERLINK l _Toc4155 104.函数作用:将选择定单元格作成镜像图片 PAGEREF _Toc4155 99 HYPERLINK l _Toc21915 105.函数作用:反选择单元格中的数 PAGEREF _Toc21915 101 HYPERLINK l _Toc21107 106.函数作用:在Excel中参加一个量度尺(以厘米为单位) PAGEREF _Toc21107 102 HYPERLINK l _Toc17074 107.函数作用:在Excel中参加一个量度尺(以寸为单位) PAGER

24、EF _Toc17074 104 HYPERLINK l _Toc5259 108.函数作用:取得一个短文件名的长文件名 PAGEREF _Toc5259 107 HYPERLINK l _Toc29297 109.函数作用:取得临时文件名 PAGEREF _Toc29297 107 HYPERLINK l _Toc27869 110.函数作用:等用Shell调用的程序执行完成后再执行其它程序 PAGEREF _Toc27869 108 HYPERLINK l _Toc22000 111.函数作用:将Mouse显示成动画 PAGEREF _Toc22000 109 HYPERLINK l _T

25、oc5025 112.函数作用:限制Mouse移动范围 PAGEREF _Toc5025 109 HYPERLINK l _Toc10756 113.函数作用:取得当前激活窗品句柄及标题 PAGEREF _Toc10756 110 HYPERLINK l _Toc2537 114.函数作用:取得屏幕分辨率 PAGEREF _Toc2537 110 HYPERLINK l _Toc3260 115.函数作用:自动建立多级目录 PAGEREF _Toc3260 111 HYPERLINK l _Toc14765 116.函数作用:将文件长度置零 PAGEREF _Toc14765 111 HYPE

26、RLINK l _Toc31695 117.函数作用:读取WIN9X / Me共享文件夹密码 PAGEREF _Toc31695 112 HYPERLINK l _Toc24312 118.函数作用:取得预设的打印机及设置预设的打印机 PAGEREF _Toc24312 115 HYPERLINK l _Toc27526 119.函数作用:获得当前操作系统的打印机个数及检测打印是否存在 PAGEREF _Toc27526 115 HYPERLINK l _Toc19376 120.函数作用:枚举打印机名称清单 PAGEREF _Toc19376 116 HYPERLINK l _Toc2506

27、0 121.函数作用:读取网络效劳器当前时间 PAGEREF _Toc25060 117 HYPERLINK l _Toc25247 122.函数作用:下载文件到指定目录 PAGEREF _Toc25247 119 HYPERLINK l _Toc8217 123.函数作用:自动映射网络驱动器 PAGEREF _Toc8217 120 HYPERLINK l _Toc19353 124.函数作用:自动断开网络驱动器 PAGEREF _Toc19353 120 HYPERLINK l _Toc29827 125.函数作用:连接选定单元格中的内容 PAGEREF _Toc29827 121 HYP

28、ERLINK l _Toc12787 126.函数作用:获取一个单元格中有指定字体颜色部份数据 PAGEREF _Toc12787 121 HYPERLINK l _Toc25037 127.函数作用:对指定文件加XLS加密 PAGEREF _Toc25037 122 HYPERLINK l _Toc10158 128.函数作用:选择指定范围内使用了填充颜色的单元格 PAGEREF _Toc10158 122 HYPERLINK l _Toc27627 129.函数作用:在特定的区域内查找文本,返回值是包含查找文本的单元格 PAGEREF _Toc27627 123 HYPERLINK l _

29、Toc23300 130.函数作用:返回特定区域中最大值的地址 PAGEREF _Toc23300 124 HYPERLINK l _Toc8702 131.函数作用:删除表格中使用范围内的所有空白单元格 PAGEREF _Toc8702 124 HYPERLINK l _Toc31022 132.函数作用:返回数组中有多少个指定的字符串 PAGEREF _Toc31022 125 HYPERLINK l _Toc29808 133.函数作用:返回当前工作表中引用了指定的单元的地址 PAGEREF _Toc29808 126 HYPERLINK l _Toc12455 134.函数作用:获取E

30、xcel中字型列表 PAGEREF _Toc12455 126 HYPERLINK l _Toc8382 135.函数作用:获取一个字符串中有多少个数字字符 PAGEREF _Toc8382 127 HYPERLINK l _Toc5685 136.函数作用:在Excel中对多列进行填充 PAGEREF _Toc5685 127 HYPERLINK l _Toc2254 137.函数作用:对选定的范围进行数据填充忽略单元格格式 PAGEREF _Toc2254 127 HYPERLINK l _Toc2937 138.函数作用:VBA Project加密及解密 PAGEREF _Toc2937

31、 128 HYPERLINK l _Toc14791 139.函数作用:列出收藏夹中的网址 PAGEREF _Toc14791 129 HYPERLINK l _Toc31455 140.函数作用:计算两个日期之间相隔的年份,比方年龄,工龄等.可计算从1000年01月01日起的日期 PAGEREF _Toc31455 130 HYPERLINK l _Toc18109 141.函数作用:从字符串提取纯数字 PAGEREF _Toc18109 131 HYPERLINK l _Toc7200 142.函数作用:将一个数组按升序排列 PAGEREF _Toc7200 132 HYPERLINK l

32、 _Toc32179 143.函数作用:将一个数组按降序排列 PAGEREF _Toc32179 132 HYPERLINK l _Toc19888 144.函数作用:删除空白列 PAGEREF _Toc19888 133 HYPERLINK l _Toc29125 145.函数作用:判断工作表是否为空白 PAGEREF _Toc29125 133 HYPERLINK l _Toc13012 146.函数作用:将数据按类分到不同工作薄 PAGEREF _Toc13012 134 HYPERLINK l _Toc27504 147.函数作用:单元格内数据排序 PAGEREF _Toc27504

33、134 HYPERLINK l _Toc820 148.函数作用:对多栏排序 PAGEREF _Toc820 135 HYPERLINK l _Toc6228 149.函数作用:返回计算公式的值 ,值的计算公式 PAGEREF _Toc6228 136 HYPERLINK l _Toc8223 150.函数作用:把第一列=某个值对应的第二列的内容连在一起，并用、隔开 PAGEREF _Toc8223 137 HYPERLINK l _Toc24046 151.函数作用:取得系统使用模式 PAGEREF _Toc24046 137 HYPERLINK l _Toc25826 152.函数作用:计

34、算机注销/关机/重启 PAGEREF _Toc25826 138 HYPERLINK l _Toc3854 153.函数作用:更改计算机名称 PAGEREF _Toc3854 138 HYPERLINK l _Toc4832 154.函数作用:从n位开始取出字符串中的汉字、英文字母、数字 PAGEREF _Toc4832 139 HYPERLINK l _Toc538 155.函数作用:在指定列中寻找含有指定字符串的单元格，并将符合条件的单元格标为红色，并将对应的下一列单元格赋值为1。 PAGEREF _Toc538 140 HYPERLINK l _Toc32582 156.函数作用:去除字

35、符串中的空格 PAGEREF _Toc32582 140 HYPERLINK l _Toc13924 157.函数作用:查找合并单元格位置 PAGEREF _Toc13924 141 HYPERLINK l _Toc6038 158.函数作用:阴阳历转换和阴阳历生日 PAGEREF _Toc6038 141 HYPERLINK l _Toc26896 159.函数作用:利用数组和Substitute来替换某字符 PAGEREF _Toc26896 145 HYPERLINK l _Toc15200 160.函数作用:一键创立斜线表头 PAGEREF _Toc15200 145 HYPERLIN

36、K l _Toc15976 作用:自动获取指定月的工作日 PAGEREF _Toc15976 146正文ByVal 表示该参数是按值方式传递的。 你在函数中修改此参数的值不会造成调用这个函数的函数的变量值的改变。ByRef 表示该参数按引用方式传递。 在函数中修改此参数的值会造成实参的值发生改变。例如：dim I as integer, J as integerI = 1 : J = 2call fun(I,J)Msgbox I= & Cstr(i) & J= & cstr(J)Function Fun(byref a, byval b) a = 5 b = 6 fun = 0函数返回值End

37、 Function将会输出I=5 J=2，即I的值被函数Fun改变了。 #1.函数作用：返回 Column 英文字#Function ColLetter(ColNumber As Integer) As String On Error GoTo Errorhandler ColLetter = Left(Cells(1, ColNumber).Address(0, 0), 1 - (ColNumber 26) Exit FunctionErrorhandler: MsgBox Error encountered, please re-enter End Function#2.函数作用：查询某一

38、值第num次出现的值 参数说明：Value1：查询引用的数值; Range1：查询区域; num：指定查询第几次出现; Col：返回值, 相对引用区域, 相对引用列的右数第Col列#Function MyFind(Value1, ByVal Range1 As Range, ByVal num As Integer, ByVal Col As Integer) If Value1 = Then Exit Function If Range1.Columns.Count 1 Then Exit Function For Each D In Range1 If D.Value = Value1 T

39、hen c = c + 1 If c = num Then v1 = D(1, Col) Exit For End If ElseIf IsEmpty(D) Then Exit For End If Next If v1 = Then v1 = not MyFind = v1End Function#3.函数作用：返回当个人工资薪金所得为2000元(起征点为850元)时的应纳个人所得税税额 语 法：Grsds(bsc, mysala) 参数说明：bsc: 必选项，为起征点，包括税法规定的工资基数800元加上允许税前扣除的合理费用; mysala: 必选项，为人个工资薪金所得。 示 例：Grsd

40、s(850, 20000) =#Function Grsds(bsc As Double, mysala As Double) As Double bsc为起征点加上允许税前扣除的合理费用,mysala为工资薪金所得 On Error GoTo Grsds_err Select Case mysala Case Is = bsc Grsds = 0 Case Is = bsc + 500 Grsds = Application.WorksheetFunction.Round(mysala - bsc) * 0.05, 2) Case Is = bsc + 2000 Grsds = Applic

41、ation.WorksheetFunction.Round(mysala - bsc) * 0.1 - 25, 2) Case Is = bsc + 5000 Grsds = Application.WorksheetFunction.Round(mysala - bsc) * 0.15 - 125, 2) Case Is = bsc + 20000 Grsds = Application.WorksheetFunction.Round(mysala - bsc) * 0.2 - 375, 2) Case Is = bsc + 40000 Grsds = Application.Workshe

42、etFunction.Round(mysala - bsc) * 0.25 - 1375, 2) Case Is = bsc + 60000 Grsds = Application.WorksheetFunction.Round(mysala - bsc) * 0.3 - 3375, 2) Case Is = bsc + 80000 Grsds = Application.WorksheetFunction.Round(mysala - bsc) * 0.35 - 6375, 2) Case Is 0 i = i + 1 Loop mydata = Val(Mid(mystring, i, L

43、en(mystring) - i + 1)End Function#6.函数作用：按SplitType取得RangeName串值中的起始位置#1:单元格，2:行号，3:列号，4:范围Public Const SINGLE_CELL = 1Public Const ROW_NUM = 2Public Const COL_NUM = 3Public Const RANGE_ALL = 4Public Function SplitRangeName(RangeName As String, SplitType As Integer) As String If VBA.Len(RangeName) 0

44、 Then RangeName = VBA.Left(RangeName, VBA.InStr(1, RangeName, :) - 1) Select Case SplitType Case SINGLE_CELL If VBA.InStr(1, RangeName, :) 0 Then SplitRangeName = $ & VBA.Left(RangeName, VBA.InStr(1, RangeName, :) - 1) Else SplitRangeName = $ & RangeName End If Case ROW_NUM SplitRangeName = VBA.IIf(

45、VBA.InStr(1, RangeName, $) 0, VBA.Right(RangeName, VBA.Len(RangeName) - VBA.InStr(1, RangeName, $), RangeName) If Not IsNumeric(SplitRangeName) Then SplitRangeName = MsgBox , vbInformation, End If Case COL_NUM If VBA.InStr(1, RangeName, $) 0 Then SplitRangeName = VBA.Left(RangeName, VBA.InStr(1, Ran

46、geName, $) - 1) Else SplitRangeName = RangeName End If If IsNumeric(SplitRangeName) Then SplitRangeName = MsgBox , vbInformation, End If Case RANGE_ALL SplitRangeName = $ & RangeName End Select End IfEnd Function#7.函数作用:将金额数字转成中文大写#Function Money(Number As Currency) Dim i, j, k, m, leng As Integer 计

47、数器 Dim Zero As Integer 连续零标识 Dim Tnumber As String 储存数字字符串,计算数组长度 Dim Num() As String 定义数组 Dim Num1(3) As String 存储万元以下数字 Dim Num2(1) As String 储存拆分后的数字 Dim Cha(8), Cha1(9), Cha2(4) As String 储存转化后的汉字 Dim Zcha As String 连接后的字符串 Dim Flag, Flag1 As Boolean 正负标志 Flag = True Flag1 = False Zero = 0 如果大于一

48、亿，那么不处理 If (Number 99999999) Or (Number -99999999) Then MsgBox (Sorry,数据超过一亿，暂不处理。) MsgBox (顺便问一下，你真有那么多钱吗？) Money = Sorry! Else If (Number = 0) Then Money = 零元整 Else *将负数数字转化正数并更改标识* If (Number 0) Then Tnumber = CStr(Int(Number * 100) / 100) Else Tnumber = CStr(Number) End If *处理四舍五入* If (Number -

49、Int(Number) * 100 - Int(Number - Int(Number) * 100) = 0.5) Then Tnumber = CStr(CCur(Tnumber) + 0.01) End If Number = CCur(Tnumber) *重新分配数组空间* ReDim Num(Len(Tnumber) - 1) As String *将字符串分开存储至数组中* For i = 0 To Len(Tnumber) - 1 Num(i) = Mid(Tnumber, i + 1, 1) Next i *定义所需字符* Dim M1, M2 M1 = Array(零, 壹,

50、 贰, 叁, 肆, 伍, 陆, 柒, 捌, 玖) M2 = Array(, 拾, 佰, 仟, 万, 亿) *处理小于一元金额* *小数点后一位，那么* If (Number - Int(Number) 0) And (Number * 100 - Int(Number) * 100) Mod 10) = 0) Then i = i - 1 Num2(0) = Num(i) Num(i) = i = i - 1 Num(i) = i = i - 1 Cha2(0) = M1(CByte(Num2(0) Cha2(1) = 角 Cha2(2) = 整 Else *小数点后两位那么* If (Num

51、ber - Int(Number) 0) Then i = i - 1 Num2(1) = Num(i) Num2(0) = Num(i - 1) Num(i) = i = i - 1 Num(i) = i = i - 1 Num(i) = i = i - 1 Cha2(0) = M1(CByte(Num2(0) Cha2(1) = 角 Cha2(2) = M1(CByte(Num2(1) Cha2(3) = 分 End If End If *分解大于一万的整数局部* If (Int(Number) 9999) Then If (Cha2(0) ) Then i = i + 1 End If

52、For j = 3 To 0 Step -1 Num1(j) = Num(i - 1) Num(i - 1) = i = i - 1 Next j Else If (Cha2(0) ) Then i = i + 1 End If For j = 0 To i - 1 Num1(j) = Num(j) Num(j) = Next j End If *转换万元以上数字* If (Num(0) ) Then leng = i j = 0 For k = 0 To leng - 1 If (Num(k) = 0) Then Zero = Zero + 1 For m = 1 To 5 If (Cha(

53、j - 1) = M2(m) Then Flag1 = True End If Next m If (Zero = 1) And (Flag1 = False) Then Cha(j) = M1(CByte(Num(k) End If If (Zero = 1) Then j = j + 1 End If Else If (Num(k) ) Then If (Zero 0) Then Cha(j - 1) = 零 End If Cha(j) = M1(CByte(Num(k) End If j = j + 1 End If If (Num(k) = 0) Then i = i - 1 Else

54、 Cha(j) = M2(i - 1) j = j + 1 i = i - 1 Zero = 0 End If Next k Cha(j - 1) = 万 Zero = 0 End If *转换万元以下数字* If (Num1(0) ) Then j = 0 Flag1 = False leng = 3 While (Num1(leng) = ) leng = leng - 1 Wend i = leng + 1 For k = 0 To leng If (Num1(k) ) Then If (Num1(k) = 0) Then Zero = Zero + 1 For m = 1 To 5 I

55、f (j 0) Then If (Cha1(j - 1) = M2(m) Then Flag1 = True End If End If Next m If (Zero = 1) And (Flag1 = False) Then Cha1(j) = M1(CByte(Num1(k) End If If (Zero = 1) Then j = j + 1 End If Else If (Num1(k) ) Then If (Zero 0) Then Cha1(j - 1) = 零 End If Cha1(j) = M1(CByte(Num1(k) End If j = j + 1 End If

56、If (Num1(k) = 0) Then i = i - 1 Else Cha1(j) = M2(i - 1) j = j + 1 i = i - 1 Zero = 0 End If End If Next k Cha1(j - 1) = 元 If (Cha2(0) = ) Then Cha1(j) = 整 End If End If *连接字符串* j = 0 While (Cha(j) ) Zcha = Zcha & Cha(j) j = j + 1 Wend j = 0 While (Cha1(j) ) Zcha = Zcha & Cha1(j) j = j + 1 Wend j =

57、0 While (Cha2(j) ) Zcha = Zcha & Cha2(j) j = j + 1 Wend *最终显示* If (Flag) Then Money = Zcha Else Money = 负 & Zcha End If End If End IfEnd Function#8.函数作用:计算某种税金#Public Function 税(fa) Dim x If (fa - 800) 0 And (fa - 800) = 500 And (fa - 800) = 2000 And (fa - 800) = 5000 And (fa - 800) = 20000 And (fa

58、- 800) = 40000 And (fa - 800) = 60000 And (fa - 800) = 80000 And (fa - 800) = 100000 Then x = (fa - 800) * 0.45 - 15375 税 = x Else End IfEnd Function#9.函数作用:人民币大、小写转换#Function 小写(k) Application.ScreenUpdating = False m1 = Application.WorksheetFunction.Round(k * 100, 0) n1 = Int(m1 / 100) n2 = Int(m1

59、 / 10) - n1 * 10 n3 = m1 - n1 * 100 - n2 * 10 e = Application.WorksheetFunction.Text(n1, DBNum1) f = Application.WorksheetFunction.Text(n2, DBNum1) g = Application.WorksheetFunction.Text(n3, DBNum1) If n3 = 0 Then 小写 = 人民币大写： & e & 元 & 整 End If If (n3 0) And (n2 0) Then 小写 = 人民币大写： & e & 元 & f & 角 &

60、 g & 分 If n1 = 0 Then 小写 = 人民币大写： & f & 角 & g & 分 End If End If If (n3 = 0) And n2 0 Then 小写 = 人民币大写： & e & 元 & f & 角 & 整 If n1 = 0 Then 小写 = 人民币大写： & f & 角 & 整 End If End If If (n3 0) And (n2 = 0) Then 小写 = 人民币大写： & e & 元 & g & 分 If n1 = 0 Then 小写 = 人民币大写： & g & 分 End If End If If k = 0 Or k = Then