较为准确的数字转大写数字函数

ttui

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

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

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

1. Option Explicit
   
2. 
   
3. Private NC(0 To 9) As String
   
4. Private Units(0 To 5) As String
   
5.    
   
6. Public Function Daxie(n As String) As String
   
7.     Dim i As Integer
   
8.         
   
9.     NC(1) = "壹":    NC(2) = "贰":    NC(3) = "叁"
   
10.     NC(4) = "肆":    NC(5) = "伍":    NC(6) = "陆"
    
11.     NC(7) = "柒":    NC(8) = "捌":    NC(9) = "玖"
    
12.     Units(0) = "千":    Units(1) = "分":   Units(2) = "角"
    
13.     Units(3) = "":   Units(4) = "拾":    Units(5) = "百"
    
14.    
    
15.     i = InStr(1, n, ".")
    
16.     If i > 0 Then
    
17.         Daxie = DaxieInt(Left(n, i - 1))  '转换整数部分
    
18.         Daxie = Daxie & IIf(Daxie <> "", "元", "") & DaxieDecimal(Right(n, Len(n) - i), Daxie <> "")
    
19.     Else
    
20.         Daxie = DaxieInt(n)  '转换小数部分
    
21.         Daxie = Daxie & IIf(Daxie <> "", "元整", "")
    
22.     End If
    
23.     If Daxie = "" Then Daxie = "零"
    
24. End Function
    
25. 
    
26. Private Function DaxieDecimal(n As String, HasInt As Boolean) As String
    
27.     DaxieDecimal = DaxieDigSeg(Left(IIf(Len(n) < 2, n & "0", n), 2), 0)  '小数部分仅转换前两位
    
28.     If Len(DaxieDecimal) = 2 Then
    
29.         DaxieDecimal = IIf(Right(DaxieDecimal, 1) = "分", IIf(hasInt, "零", "") & DaxieDecimal, DaxieDecimal & "整")
    
30.     End If
    
31. End Function
    
32. 
    
33. Private Function DaxieInt(n As String) As String
    
34.     Dim i As Integer, k As Integer, l As Integer
    
35.     Dim x As String
    
36.    
    
37.     l = Len(n)
    
38.     If l Mod 4 > 0 Then n = String(((l \ 4) + 1) * 4 - l, "0") & n  '数的长度凑为4的整数倍
    
39.     l = Len(n) \ 4
    
40.     k = -1
    
41.     For i = 1 To l
    
42.         x = Mid(n, (i - 1) * 4 + 1, 4)  '以4位为一段转换为中文大写
    
43.         If k Mod 10 = 0 Then  '处理需要添零的情况
    
44.             DaxieInt = DaxieInt & IIf(x > 0, "零", "")
    
45.         ElseIf k > 0 And x < 1000 And x > 0 Then
    
46.             DaxieInt = DaxieInt & "零"
    
47.         End If
    
48.         If (l - i + 1) Mod 2 = 0 Then  '加注单位
    
49.             DaxieInt = DaxieInt & DaxieDigSeg(x) & IIf(x > 0, "万", "")
    
50.         Else
    
51.             DaxieInt = DaxieInt & DaxieDigSeg(x) & IIf(i < l, "亿", "")
    
52.         End If
    
53.         k = x
    
54.     Next i
    
55. End Function
    
56. 
    
57. Private Function DaxieDigSeg(n As String, Optional uoffset As Integer = 2) As String  '最长4位数字转为中文大写
    
58.     Dim i As Integer, j As Integer, k As Integer, l As Integer
    
59.    
    
60.     l = Len(n)
    
61.     k = -1
    
62.     For i = l To 1 Step -1
    
63.         j = Mid(n, i, 1)
    
64.         If j > 0 Then DaxieDigSeg = NC(j) & Units((l - i + 1 + uoffset) Mod 6) & IIf(k = 0 And DaxieDigSeg <> "", "零", "") & DaxieDigSeg
    
65.         k = j
    
66.     Next i
    
67. End Function

复制代码

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

一剑惊心

不用这么复杂吧，况且18.3显示成壹拾捌元零叁角整，这其中的零没必要吧

ttui

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

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

mjzxlmg

Daxie("1000000030000030.236")


没有四舍五入算法

ttui

mjzxlmg 发表于 2014-5-25 17:15
Daxie("1000000030000030.236")

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

loquat

挖个坟，我也是很久以前写的老代码，抛砖引玉
稍作简化，干掉一些多余代码
代码仍有部分问题：
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

复制代码