1、如何自定义:
打开EXCEL,新建一个文件Book1,按ALT+F11进入VBA编程环境,选中这个BOOK1文件,插入模块,将下面的源代码复制到右边的模块代码区内,然后将此BOOK1保存,保存类型一定选加载宏,文件名嘛可自由发挥,我就填"中文大写",确定OK!然后回到EXCEL,工具--加载宏-找到"中文大写",打勾确定,我们这个自定义函数就可以象内置函数样使用了!--->=rmbdx(123456.78),爽吧! 2、例子: A、直接在函数内输入数值的(请注意参数的用法,默认用法是不用输入) =rmbdx(123456.78)--->壹拾贰万叁仟肆佰伍拾陆元柒角捌分 =rmbdx(123456.78,0)--->壹拾贰万叁仟肆佰伍拾陆元柒角捌分 =rmbdx(123456.78,1)--->壹拾贰万叁仟肆佰伍拾陆元柒角捌分 =rmbdx(56.78)--->伍拾陆元柒角捌分 =rmbdx(0.78)--->柒角捌分 =rmbdx(0.784)--->柒角捌分 =rmbdx(0.785,1)--->柒角玖分 =rmbdx(0.02,1)--->贰分 B、引用某单元格数值进行转换的 假设你的D3单元格的数据(也可以是求和或其它公式得出的结果)需要转换,大写格式放在D4单元格,则D4输入公式:=rmbdx(d3)即可 C、其它形如=rmbdx(SUM(C4:C6))的也可以,用法象内置函数,请灵活使用 3、源代码: Function rmbdx(value, Optional m = 0)
‘中文大写源代码, ‘支持负数,支持小数点后的第三位数是否进行四舍五入处理 ‘默认参数为0,即不将小数点后的第三位数进行四舍五入处理 On Error Resume Next Dim a Dim jf As String ‘定义角分位 Dim j ‘定义角位 Dim f ‘定义分位 If value < 0 Then ‘处理正负数的情况 a = "负" Else a = "" End If If IsNumeric(value) = False Then ‘判断待转换的value是否为数值
rmbdx = "需转换的内容非数值" Else value = Abs(CCur(value)) ‘当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理 ‘当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理 If m = 0 Then jf = Fix((value - Fix(value)) * 100) value = Fix(value) + jf / 100 Else ‘厘位进行四舍五入实践很少用到,但还是要照顾到 value = Application.WorksheetFunction.Round(value, 2) ‘-->这句是关键!只用round有bug jf = Round((value - Fix(value)) * 100, 0) End If If value = 0 Or value = "" Then ‘当待转换数值为0或空时,不进行转换 rmbdx = "" Else strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" ‘转换整数位 If Int(value) = 0 Then strrmbdx = "" End If If Int(value) <> value Then If jf > 9 Then ‘判断小数位 j = Left(jf, 1) f = Right(jf, 1) Else j = 0 f = jf End If If j <> 0 And f <> 0 Then ‘角分位都有时
jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _ & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分" Else ‘处理出现零几分的情况 If Int(value) = 0 And j = 0 And f <> 0 Then jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分" Else If j = 0 Then ‘有分无角时 jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分" Else If f = 0 Then ‘有角无分时 jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整" End If End If End If End If strrmbdx = strrmbdx & jf ‘组装 Else strrmbdx = strrmbdx & "整" End If rmbdx = a & strrmbdx ‘最后成型了,MM满意了吧 End If End If End Function |
|