[推荐]：两个人民币大写转换函数

alim

以下函数代码来自网上，并稍作修改，版权归原作者。

2. 
   
3.   [FONT=courier new]
   
4. Function d(q)
   
5. 
   
6.     ybb = Round(q * 100)            '将输入的数值扩大100倍，进行四舍五入
   
7.     y = Int(ybb / 100)              '截取出整数部分
   
8.     j = Int(ybb / 10) - y * 10      '截取出十分位
   
9.     f = ybb - y * 100 - j * 10      '截取出百分位
   
10. 
    
11.     zy = Application.WorksheetFunction.Text(y, "[dbnum2]")      '将整数部分转为中文大写
    
12.     zj = Application.WorksheetFunction.Text(j, "[dbnum2]")      '将十分位转为中文大写
    
13.     zf = Application.WorksheetFunction.Text(f, "[dbnum2]")      '将百分位转为中文大写
    
14. 
    
15.     d = zy & "元"
    
16.    
    
17.     If f <> 0 And j <> 0 Then
    
18.         d = d & zj & "角" & zf & "分"
    
19.         If y = 0 Then
    
20.             d = zj & "角" & zf & "分"
    
21.         End If
    
22.     End If
    
23.    
    
24.     If f = 0 And j <> 0 Then
    
25.         d = d & zj & "角"
    
26.         If y = 0 Then
    
27.             d = zj & "角"
    
28.         End If
    
29.     End If
    
30.    
    
31.     If f <> 0 And j = 0 Then
    
32.         d = d & zj & zf & "分"
    
33.         If y = 0 Then
    
34.             d = zf & "分"
    
35.         End If
    
36.     End If
    
37.    
    
38.     If f = 0 And j = 0 Then
    
39.         d = d & "整"
    
40.     End If
    
41.          
    
42.     If q = "" Or q = 0 Then
    
43.         d = ""                       '如没有输入任何数值为空
    
44.     End If
    
45. 
    
46. End Function
    
47.   [/FONT]
    

<br />   [FONT=courier new]<br /> Function d(q)<br /> <br />     ybb = Round(q * 100)            '将输入的数值扩大100倍，进行四舍五入<br />     y = Int(ybb / 100)              '截取出整数部分<br />     j = Int(ybb / 10) - y * 10      '截取出十分位<br />     f = ybb - y * 100 - j * 10      '截取出百分位<br /> <br />     zy = Application.WorksheetFunction.Text(y, "[dbnum2]")      '将整数部分转为中文大写<br />     zj = Application.WorksheetFunction.Text(j, "[dbnum2]")      '将十分位转为中文大写<br />     zf = Application.WorksheetFunction.Text(f, "[dbnum2]")      '将百分位转为中文大写<br /> <br />     d = zy & "元"<br />     <br />     If f <> 0 And j <> 0 Then<br />         d = d & zj & "角" & zf & "分"<br />         If y = 0 Then<br />             d = zj & "角" & zf & "分"<br />         End If<br />     End If<br />     <br />     If f = 0 And j <> 0 Then<br />         d = d & zj & "角"<br />         If y = 0 Then<br />             d = zj & "角"<br />         End If<br />     End If<br />     <br />     If f <> 0 And j = 0 Then<br />         d = d & zj & zf & "分"<br />         If y = 0 Then<br />             d = zf & "分"<br />         End If<br />     End If<br />     <br />     If f = 0 And j = 0 Then<br />         d = d & "整"<br />     End If<br />           <br />     If q = "" Or q = 0 Then<br />         d = ""                       '如没有输入任何数值为空<br />     End If<br /> <br /> End Function<br />   [/FONT]<br />

2. 
   
3.   [FONT=courier new]
   
4. Function rmbdx(value, Optional m = 1)
   
5. '中文大写源代码,By 对面男孩、redwin
   
6. '支持负数,支持小数点后的第三位数是否进行四舍五入处理
   
7. '默认参数为1,即小数点后的第三位数进行四舍五入处理
   
8. '2002-10-11--2002-10-13
   
9. 
   
10. On Error Resume Next
    
11. Dim a
    
12. Dim jf As String   '定义角分位
    
13. Dim j '定义角位
    
14. Dim f '定义分位
    
15. 
    
16. 
    
17. If IsNumeric(value) = False Then '判断待转换的value是否为数值
    
18.     rmbdx = ""
    
19. Else
    
20. 
    
21. If value < 0 Then '处理正负数的情况
    
22.     a = "负"
    
23. Else
    
24.     a = ""
    
25. End If
    
26. 
    
27. value = Abs(CCur(value))
    
28. 
    
29. '当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理
    
30. '当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理
    
31. 
    
32. If m = 0 Then
    
33.    jf = Fix((value - Fix(value)) * 100)
    
34.    value = Fix(value) + jf / 100
    
35. Else '厘位进行四舍五入实践很少用到,但还是要照顾到
    
36.    value = Application.WorksheetFunction.Round(value, 2) '-->这句是关键!只用round有bug
    
37.    jf = Round((value - Fix(value)) * 100, 0)
    
38. End If
    
39. 
    
40. If value = 0 Or value = "" Then '当待转换数值为0或空时,不进行转换
    
41.      rmbdx = ""
    
42. Else
    
43. 
    
44. strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" '转换整数位
    
45.    If Int(value) = 0 Then
    
46.       strrmbdx = ""
    
47.    End If
    
48. 
    
49.    If Int(value) <> value Then
    
50.         If jf > 9 Then '判断小数位
    
51.              j = Left(jf, 1)
    
52.              f = Right(jf, 1)
    
53.         Else
    
54.              j = 0
    
55.              f = jf
    
56.         End If
    
57. 
    
58.         If j <> 0 And f <> 0 Then '角分位都有时
    
59.             jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _
    
60.                     & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
    
61.         Else            '处理出现零几分的情况
    
62.             If Int(value) = 0 And j = 0 And f <> 0 Then
    
63.                 jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
    
64.             Else
    
65.                 If j = 0 Then '有分无角时
    
66.                         jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
    
67.                 Else
    
68.                     If f = 0 Then '有角无分时
    
69.                         jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整"
    
70.                 End If
    
71.             End If
    
72.         End If
    
73.     End If
    
74.    
    
75.     strrmbdx = strrmbdx & jf '组装
    
76.    
    
77.     Else
    
78.        strrmbdx = strrmbdx & "整"
    
79.     End If
    
80.    
    
81.     rmbdx = a & strrmbdx '最后成型了,各位MM满意了吧
    
82.    
    
83. End If
    
84. 
    
85. End If
    
86. 
    
87. End Function
    
88. 
    
89.   [/FONT]
    

<br />   [FONT=courier new]<br /> Function rmbdx(value, Optional m = 1)<br /> '中文大写源代码,By 对面男孩、redwin<br /> '支持负数,支持小数点后的第三位数是否进行四舍五入处理<br /> '默认参数为1,即小数点后的第三位数进行四舍五入处理<br /> '2002-10-11--2002-10-13<br /> <br /> On Error Resume Next<br /> Dim a<br /> Dim jf As String   '定义角分位<br /> Dim j '定义角位<br /> Dim f '定义分位<br /> <br /> <br /> If IsNumeric(value) = False Then '判断待转换的value是否为数值<br />     rmbdx = ""<br /> Else<br /> <br /> If value < 0 Then '处理正负数的情况<br />     a = "负"<br /> Else<br />     a = ""<br /> End If<br /> <br /> value = Abs(CCur(value))<br /> <br /> '当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理<br /> '当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理<br /> <br /> If m = 0 Then<br />    jf = Fix((value - Fix(value)) * 100)<br />    value = Fix(value) + jf / 100<br /> Else '厘位进行四舍五入实践很少用到,但还是要照顾到<br />    value = Application.WorksheetFunction.Round(value, 2) '-->这句是关键!只用round有bug<br />    jf = Round((value - Fix(value)) * 100, 0)<br /> End If<br /> <br /> If value = 0 Or value = "" Then '当待转换数值为0或空时,不进行转换<br />      rmbdx = ""<br /> Else<br /> <br /> strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" '转换整数位<br />    If Int(value) = 0 Then<br />       strrmbdx = ""<br />    End If<br /> <br />    If Int(value) <> value Then<br />         If jf > 9 Then '判断小数位<br />              j = Left(jf, 1)<br />              f = Right(jf, 1)<br />         Else<br />              j = 0<br />              f = jf<br />         End If<br /> <br />         If j <> 0 And f <> 0 Then '角分位都有时<br />             jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _<br />                     & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"<br />         Else            '处理出现零几分的情况<br />             If Int(value) = 0 And j = 0 And f <> 0 Then<br />                 jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"<br />             Else<br />                 If j = 0 Then '有分无角时<br />                         jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"<br />                 Else<br />                     If f = 0 Then '有角无分时<br />                         jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整"<br />                 End If<br />             End If<br />         End If<br />     End If<br />     <br />     strrmbdx = strrmbdx & jf '组装<br />     <br />     Else<br />        strrmbdx = strrmbdx & "整"<br />     End If<br />     <br />     rmbdx = a & strrmbdx '最后成型了,各位MM满意了吧<br />     <br /> End If<br /> <br /> End If<br /> <br /> End Function<br /> <br />   [/FONT]<br />

alim

为方便初学者，提供已编写好的程序模块，可将其解压后直接导入到工作簿中，建议导入到个人宏工作簿，便于随时调用。

alim

两个函数功能是一样的，任选一个使用。

使用举例：

在工作表中，假如数值在A1单元格，大写将放在B1单元格，那么在B1单元格输入公式：“=PERSONAL.XLS!d(A1)”。如果函数被保存在当前工作簿，则公式只写“=d(A1)”即可。当然也可以用粘贴函数向导（fx）来完成，函数应该选用户自定义，右边的列表就能列出。

bluechrist

二楼的具体怎么操作

alim

看图

小香猪

谢谢ailm，你好强，解决了我的大问题，向你学习

dellken

还行！！多谢！！！

midali2005

感谢提供哦

luloveyan

什么情况下使用方便

fecilitytea

谢谢啊，学习了。

163WX

1983年中国制造,长173cm,净重56kg.采用人工智能,各部分零件齐全,运转稳定,经二十多年的运行,属信得过产品.该产品手续齐全,无限期包退包换.现因发展需要,诚招志同道合者(仅限女性)共同研制开发第二代产品,有意者请联系哟!
你真会做广告