ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1943|回复: 5

[分享] 较为准确的数字转大写数字函数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-5-25 11:28 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 ttui 于 2014-5-25 15:21 编辑

网上有许多阿拉伯数字转中文大写数字的函数,最常见的是Num2Chi但其效果并不理想,很多情况都有错误,如100000000(一亿)会转换为“壹亿万元整”等,对金融机构来说其能正确转换的数字长度实在没法满足需求。为了用得踏实便自己写了一个,分享出来以供参考。

用法:Daxie(阿拉伯数字),数字不限长度,过长的数字请作为文本传递,如 Daxie("1000000030000030.231") ,转换结果为 壹千万亿零叁千万零叁拾元贰角叁分。

P.S. 二楼说的问题已解决,小数部分转换规则写错了,感谢一剑惊心

  1. Option Explicit

  2. Private NC(0 To 9) As String
  3. Private Units(0 To 5) As String
  4.    
  5. Public Function Daxie(n As String) As String
  6.     Dim i As Integer
  7.         
  8.     NC(1) = "壹":    NC(2) = "贰":    NC(3) = "叁"
  9.     NC(4) = "肆":    NC(5) = "伍":    NC(6) = "陆"
  10.     NC(7) = "柒":    NC(8) = "捌":    NC(9) = "玖"
  11.     Units(0) = "千":    Units(1) = "分":   Units(2) = "角"
  12.     Units(3) = "":   Units(4) = "拾":    Units(5) = "百"
  13.    
  14.     i = InStr(1, n, ".")
  15.     If i > 0 Then
  16.         Daxie = DaxieInt(Left(n, i - 1))  '转换整数部分
  17.         Daxie = Daxie & IIf(Daxie <> "", "元", "") & DaxieDecimal(Right(n, Len(n) - i), Daxie <> "")
  18.     Else
  19.         Daxie = DaxieInt(n)  '转换小数部分
  20.         Daxie = Daxie & IIf(Daxie <> "", "元整", "")
  21.     End If
  22.     If Daxie = "" Then Daxie = "零"
  23. End Function

  24. Private Function DaxieDecimal(n As String, HasInt As Boolean) As String
  25.     DaxieDecimal = DaxieDigSeg(Left(IIf(Len(n) < 2, n & "0", n), 2), 0)  '小数部分仅转换前两位
  26.     If Len(DaxieDecimal) = 2 Then
  27.         DaxieDecimal = IIf(Right(DaxieDecimal, 1) = "分", IIf(hasInt, "零", "") & DaxieDecimal, DaxieDecimal & "整")
  28.     End If
  29. End Function

  30. Private Function DaxieInt(n As String) As String
  31.     Dim i As Integer, k As Integer, l As Integer
  32.     Dim x As String
  33.    
  34.     l = Len(n)
  35.     If l Mod 4 > 0 Then n = String(((l \ 4) + 1) * 4 - l, "0") & n  '数的长度凑为4的整数倍
  36.     l = Len(n) \ 4
  37.     k = -1
  38.     For i = 1 To l
  39.         x = Mid(n, (i - 1) * 4 + 1, 4)  '以4位为一段转换为中文大写
  40.         If k Mod 10 = 0 Then  '处理需要添零的情况
  41.             DaxieInt = DaxieInt & IIf(x > 0, "零", "")
  42.         ElseIf k > 0 And x < 1000 And x > 0 Then
  43.             DaxieInt = DaxieInt & "零"
  44.         End If
  45.         If (l - i + 1) Mod 2 = 0 Then  '加注单位
  46.             DaxieInt = DaxieInt & DaxieDigSeg(x) & IIf(x > 0, "万", "")
  47.         Else
  48.             DaxieInt = DaxieInt & DaxieDigSeg(x) & IIf(i < l, "亿", "")
  49.         End If
  50.         k = x
  51.     Next i
  52. End Function

  53. Private Function DaxieDigSeg(n As String, Optional uoffset As Integer = 2) As String  '最长4位数字转为中文大写
  54.     Dim i As Integer, j As Integer, k As Integer, l As Integer
  55.    
  56.     l = Len(n)
  57.     k = -1
  58.     For i = l To 1 Step -1
  59.         j = Mid(n, i, 1)
  60.         If j > 0 Then DaxieDigSeg = NC(j) & Units((l - i + 1 + uoffset) Mod 6) & IIf(k = 0 And DaxieDigSeg <> "", "零", "") & DaxieDigSeg
  61.         k = j
  62.     Next i
  63. End Function
复制代码





补充内容 (2014-6-6 20:59):
第12行的“千”应改为“仟”,13行的“百”应改为“佰”,唉,又犯低级错误了……

TA的精华主题

TA的得分主题

发表于 2014-5-25 12:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
不用这么复杂吧,况且18.3显示成壹拾捌元叁角整,这其中的零没必要吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-5-25 15:28 | 显示全部楼层
一剑惊心 发表于 2014-5-25 12:55
不用这么复杂吧,况且18.3显示成壹拾捌元零叁角整,这其中的零没必要吧

谢谢测试,问题解决,代码已更新。注意力主要放在整数部分,小数转换代码出了问题@_@因为主要考虑excel之外环境使用,所以代码没有用excel特定代码,和公式相比确实是长多了,不过相比常见转换代码还算稍短吧。如果有更好代码希望分享出来,因为主要从逻辑相对清晰、实用性尽可能强角度来写的,没考虑过太多代码长度和复杂度问题。

TA的精华主题

TA的得分主题

发表于 2014-5-25 17:15 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-5-25 21:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
mjzxlmg 发表于 2014-5-25 17:15
Daxie("1000000030000030.236")

确实是,不过是刻意没有四舍五入。写这个转换函数主要用于俺的凭证打印工具,界面逻辑会检查小数位,超过两位的都会作为错误进行提示。如果万一哪天新写的部分忘记检查,我也希望通过可能出现的大小写不一致来尽快发现问题,所以没加进入。呵呵,个人需求罢了

TA的精华主题

TA的得分主题

发表于 2017-8-24 11:22 | 显示全部楼层
本帖最后由 loquat 于 2017-8-27 11:19 编辑

挖个坟,我也是很久以前写的老代码,抛砖引玉
稍作简化,干掉一些多余代码
代码仍有部分问题:
1.不处理0元的情况
2.代码里认为“兆”是亿亿的单位,但是这不是法定单位
   法定亿以上的单位是这样称呼的“万万亿”,如果数字更大就这样称呼“万万万万万亿”
   代码思路很明白,改动很简单,改strCNAll即可

  1. Function GetChineseNum2_loquat(ByVal aNum As String) As String
  2. Dim i%, aChar$, aIndex%
  3. Dim strInt$, strDec$, aTemp$, aLen%, strNum$
  4. If IsNumeric(aNum) = False Then Exit Function  '如果不是数字,则退出函数
  5. strCNAll = "万仟佰拾亿仟佰拾万仟佰拾兆仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
  6. 'strCNAll = "仟佰拾亿仟佰拾万仟佰拾兆仟佰拾亿仟佰拾万仟佰拾京万仟佰拾亿仟佰拾万仟佰拾兆仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"  '改成这行可以支持到“京”
  7. strNum = "零壹贰叁肆伍陆柒捌玖"
  8. aIndex = InStr(1, aNum, ".")           '小数点位置
  9. If aIndex - 1 > Len(strCNAll) Then Exit Function  '整数部分超出处理范围
  10. If aIndex Then                         '如果有小数
  11.     strInt = Left(aNum, aIndex - 1)    '取出整数部分
  12.     strDec = Mid(aNum, aIndex)         '取出小数部分(含小数点)
  13.     strDec = Round(strDec, 2)          '预处理超过2位的小数,四舍五入,后面不会有多余的0
  14.     strCNAll = strCNAll & Left("角分", Len(strDec) - 1)  '根据小数位数决定并入的单位
  15.     aNum = strInt & Mid(strDec, 2)     '合并数字字符串,并删除小数点
  16. End If
  17. strCNAll = Right(strCNAll, Len(aNum))  '根据数字长度量身定制单位
  18. aTemp = ""                             '变量初始化
  19. aLen = Len(aNum)                       '存储数字字符串的长度
  20. For i = 1 To aLen
  21.     aChar = Mid(aNum, i, 1)
  22.     aChar = Mid(strNum, CInt(aChar) + 1, 1)      '转成中文
  23.     aTemp = aTemp & aChar & Mid(strCNAll, i, 1)  '插入单位
  24. Next
  25. If aIndex = 0 Then aTemp = aTemp & "整"          '如果不包含小数点,后加“整”
  26. aTemp = Replace(aTemp, "零拾", "零")
  27. aTemp = Replace(aTemp, "零佰", "零")
  28. aTemp = Replace(aTemp, "零仟", "零")
  29. aTemp = Replace(aTemp, "零万", "万")
  30. aTemp = Replace(aTemp, "零亿", "亿")
  31. aTemp = Replace(aTemp, "零兆", "兆")
  32. aTemp = Replace(aTemp, "零京", "京")
  33. Do
  34.     aTemp = Replace(aTemp, "零零", "零")   '删除“零零”
  35. Loop While InStr(1, aTemp, "零零")   '检查还有没有“零零”
  36. aTemp = Replace(aTemp, "零元", "元")             '以下删除多余零值
  37. GetChineseNum2_loquat = aTemp
  38. End Function
复制代码

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 04:28 , Processed in 0.041822 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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