找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1277|回复: 10

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

[复制链接]
发表于 2003-8-9 09:39:27 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

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

  1.   [FONT=courier new]
  2. Function d(q)

  3.     ybb = Round(q * 100)            '将输入的数值扩大100倍,进行四舍五入
  4.     y = Int(ybb / 100)              '截取出整数部分
  5.     j = Int(ybb / 10) - y * 10      '截取出十分位
  6.     f = ybb - y * 100 - j * 10      '截取出百分位

  7.     zy = Application.WorksheetFunction.Text(y, "[dbnum2]")      '将整数部分转为中文大写
  8.     zj = Application.WorksheetFunction.Text(j, "[dbnum2]")      '将十分位转为中文大写
  9.     zf = Application.WorksheetFunction.Text(f, "[dbnum2]")      '将百分位转为中文大写

  10.     d = zy & "元"
  11.    
  12.     If f <> 0 And j <> 0 Then
  13.         d = d & zj & "角" & zf & "分"
  14.         If y = 0 Then
  15.             d = zj & "角" & zf & "分"
  16.         End If
  17.     End If
  18.    
  19.     If f = 0 And j <> 0 Then
  20.         d = d & zj & "角"
  21.         If y = 0 Then
  22.             d = zj & "角"
  23.         End If
  24.     End If
  25.    
  26.     If f <> 0 And j = 0 Then
  27.         d = d & zj & zf & "分"
  28.         If y = 0 Then
  29.             d = zf & "分"
  30.         End If
  31.     End If
  32.    
  33.     If f = 0 And j = 0 Then
  34.         d = d & "整"
  35.     End If
  36.          
  37.     If q = "" Or q = 0 Then
  38.         d = ""                       '如没有输入任何数值为空
  39.     End If

  40. End Function
  41.   [/FONT]


  1.   [FONT=courier new]
  2. Function rmbdx(value, Optional m = 1)
  3. '中文大写源代码,By 对面男孩、redwin
  4. '支持负数,支持小数点后的第三位数是否进行四舍五入处理
  5. '默认参数为1,即小数点后的第三位数进行四舍五入处理
  6. '2002-10-11--2002-10-13

  7. On Error Resume Next
  8. Dim a
  9. Dim jf As String   '定义角分位
  10. Dim j '定义角位
  11. Dim f '定义分位


  12. If IsNumeric(value) = False Then '判断待转换的value是否为数值
  13.     rmbdx = ""
  14. Else

  15. If value < 0 Then '处理正负数的情况
  16.     a = "负"
  17. Else
  18.     a = ""
  19. End If

  20. value = Abs(CCur(value))

  21. '当参数m不输入(默认为0)或为0时,小数点后的第三数不进行四舍五入处理
  22. '当参数m为1或其它数值时,小数点后的第三数进行四舍五入处理

  23. If m = 0 Then
  24.    jf = Fix((value - Fix(value)) * 100)
  25.    value = Fix(value) + jf / 100
  26. Else '厘位进行四舍五入实践很少用到,但还是要照顾到
  27.    value = Application.WorksheetFunction.Round(value, 2) '-->这句是关键!只用round有bug
  28.    jf = Round((value - Fix(value)) * 100, 0)
  29. End If

  30. If value = 0 Or value = "" Then '当待转换数值为0或空时,不进行转换
  31.      rmbdx = ""
  32. Else

  33. strrmbdx = Application.WorksheetFunction.Text(Int(value), "[DBNum2]") & "元" '转换整数位
  34.    If Int(value) = 0 Then
  35.       strrmbdx = ""
  36.    End If

  37.    If Int(value) <> value Then
  38.         If jf > 9 Then '判断小数位
  39.              j = Left(jf, 1)
  40.              f = Right(jf, 1)
  41.         Else
  42.              j = 0
  43.              f = jf
  44.         End If

  45.         If j <> 0 And f <> 0 Then '角分位都有时
  46.             jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角" _
  47.                     & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
  48.         Else            '处理出现零几分的情况
  49.             If Int(value) = 0 And j = 0 And f <> 0 Then
  50.                 jf = Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
  51.             Else
  52.                 If j = 0 Then '有分无角时
  53.                         jf = "零" & Application.WorksheetFunction.Text(f, "[DBNum2]") & "分"
  54.                 Else
  55.                     If f = 0 Then '有角无分时
  56.                         jf = Application.WorksheetFunction.Text(j, "[DBNum2]") & "角整"
  57.                 End If
  58.             End If
  59.         End If
  60.     End If
  61.    
  62.     strrmbdx = strrmbdx & jf '组装
  63.    
  64.     Else
  65.        strrmbdx = strrmbdx & "整"
  66.     End If
  67.    
  68.     rmbdx = a & strrmbdx '最后成型了,各位MM满意了吧
  69.    
  70. End If

  71. End If

  72. End Function

  73.   [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2003-8-9 09:50:39 | 显示全部楼层
为方便初学者,提供已编写好的程序模块,可将其解压后直接导入到工作簿中,建议导入到个人宏工作簿,便于随时调用。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-8-9 10:48:50 | 显示全部楼层
两个函数功能是一样的,任选一个使用。

使用举例:

在工作表中,假如数值在A1单元格,大写将放在B1单元格,那么在B1单元格输入公式:“=PERSONAL.XLS!d(A1)”。如果函数被保存在当前工作簿,则公式只写“=d(A1)”即可。当然也可以用粘贴函数向导(fx)来完成,函数应该选用户自定义,右边的列表就能列出。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-8-12 13:03:48 | 显示全部楼层
二楼的具体怎么操作
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2003-8-12 15:00:29 | 显示全部楼层
看图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2003-8-14 01:16:52 | 显示全部楼层
谢谢ailm,你好强,解决了我的大问题,向你学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2004-7-8 01:29:32 | 显示全部楼层
还行!!多谢!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-6-19 09:43:08 | 显示全部楼层
感谢提供哦
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-7-13 23:32:53 | 显示全部楼层
什么情况下使用方便
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-7-15 09:09:01 | 显示全部楼层
谢谢啊,学习了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-7-25 17:35:37 | 显示全部楼层
1983年中国制造,长173cm,净重56kg.采用人工智能,各部分零件齐全,运转稳定,经二十多年的运行,属信得过产品.该产品手续齐全,无限期包退包换.现因发展需要,诚招志同道合者(仅限女性)共同研制开发第二代产品,有意者请联系哟!
你真会做广告
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-22 21:47 , Processed in 0.467848 second(s), 52 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表