人民币中文大写（宏）2019-6-1

413191246se

* 全文查找人民币小写金额（如37.56元），在其前/后添加人民币中文大写（人民币叁拾柒元伍角陆分）。
* 默认 c=0 大写在后；如果想大写在前，只须将第 4 行代码 c=0 修改为 c=1 即可。

1. Sub 人民币中文大写()
   
2. 
   
3. '全文查找数字元(大写在前c=1/大写在后c=0)
   
4. 
   
5.     Const s As String = "万仟佰拾亿仟佰拾万仟佰拾元角分"
   
6. 
   
7.     Dim c&, i$, j&, a$, n&
   
8. 
   
9.     c = 0
   
10. 
    
11.     With ActiveDocument.Content.Find
    
12.         .ClearFormatting
    
13.         .Text = "[0-9. 　^s^t,，]{1,}元"
    
14.         .Forward = True
    
15.         .MatchWildcards = True
    
16.         Do While .Execute
    
17.             With .Parent
    
18.                 .MoveEnd 1, -1
    
19. 
    
20.                 i = .Text
    
21. 
    
22.                 i = Replace(i, " ", "")
    
23.                 i = Replace(i, "　", "")
    
24.                 i = Replace(i, vbTab, "")
    
25.                 i = Replace(i, ChrW(160), "")
    
26.                 i = Replace(i, ",", "")
    
27.                 i = Replace(i, "，", "")
    
28. 
    
29.                 If i Like "*.*.*" Then .Font.Color = wdColorRed: GoTo sk
    
30. 
    
31.                 i = Format(i, "Standard")
    
32.                 i = Replace(i, ",", "")
    
33.                 i = Replace(i, ".", "")
    
34. 
    
35.                 j = Len(i)
    
36. 
    
37.                 If j > 15 Then GoTo sk
    
38. 
    
39.                 a = ""
    
40. 
    
41.                 For n = 1 To j
    
42.                     a = a & Mid(i, n, 1) & Mid(s, 15 - j + n, 1)
    
43.                 Next n
    
44. 
    
45.                 a = Replace(a, "1", "壹")
    
46.                 a = Replace(a, "2", "贰")
    
47.                 a = Replace(a, "3", "叁")
    
48.                 a = Replace(a, "4", "肆")
    
49.                 a = Replace(a, "5", "伍")
    
50.                 a = Replace(a, "6", "陆")
    
51.                 a = Replace(a, "7", "柒")
    
52.                 a = Replace(a, "8", "捌")
    
53.                 a = Replace(a, "9", "玖")
    
54.                 a = Replace(a, "0", "零")
    
55. '''
    
56.                 a = Replace(a, "零仟", "零")
    
57.                 a = Replace(a, "零佰", "零")
    
58.                 a = Replace(a, "零拾", "零")
    
59. 
    
60.                 Do While a Like "*零零*"
    
61.                     a = Replace(a, "零零", "零")
    
62.                 Loop
    
63. 
    
64.                 a = Replace(a, "零亿", "亿零")
    
65.                 a = Replace(a, "零万", "万零")
    
66.                 a = Replace(a, "零元", "元零")
    
67. 
    
68.                 Do While a Like "*零零*"
    
69.                     a = Replace(a, "零零", "零")
    
70.                 Loop
    
71. 
    
72.                 a = Replace(a, "零角零分", "整")
    
73.                 a = Replace(a, "零角", "零")
    
74.                 a = Replace(a, "零分", "")
    
75. 
    
76.                 If a Like "元零*" Then a = Replace(a, "元零", "")
    
77.                 If a = "元整" Then a = "零" & a
    
78. 
    
79.                 If a Like "*万零元*" And Val(a) < 100000000 Then a = Replace(a, "万零元", "万元") '10万<=X<1亿
    
80.                 a = Replace(a, "亿万", "亿")
    
81. 
    
82.                 If a Like "*亿零万*" Then a = Replace(a, "零万", "") '>=10亿
    
83. '''
    
84.                 If c = 1 Then
    
85.                     .InsertBefore Text:="（人民币" & a & "）"
    
86.                 Else
    
87.                     .MoveEnd
    
88.                     .InsertAfter Text:="（人民币" & a & "）"
    
89.                 End If
    
90. sk:
    
91.                 .Start = .End
    
92.             End With
    
93.         Loop
    
94.     End With
    
95. End Sub

复制代码

qdnzlh

我也做一点贡献，在楼主代码的基础上修改的。

代码解析：

[1] 本代码对楼主413191246se的代码进行了修改，首先大写数字和单位在循环中一次性转换，其次，关键点是采用正则表达式去零，避免了很多IF判断，使得代码更简洁，结构更清晰。不过，如果没有正则表达式知识，就很难看得懂了。

[2] 采用从文尾到文首的倒序查找模式。查找顺序由属性.Forward控制，=False为倒序查找，=True为正序查找。倒序查找的好处是，插入大写后，选定文本起止位置比较好控制，不容易混乱。第四行将光标定位在文首，倒序查找就需要绕回文尾处，故必须有第10行的代码.Wrap = wdFindContinue，意即绕回继续查找。该代码的作用是再做一次全文倒序查找，直到查至文首或文尾时停止，不再继续绕回。所以，若上次光标不是在文首，而是在文中，那么此次就会有部分查找过程是重复的。若光标首先定位在文尾，那就不需要第10行代码了。

[3] 具体的查找动作由.Execute方法执行。查找成功返回True，失败返回False。成功时，父对象.Parrent的内容将会发生改变，此时父对象所代表的内容已不再是原来的了，而变成了查找到的内容了。

[4] 代码中的关键部分是正则表达式去零。去零后的大写完全符合人民币读写规则。

1. Private Sub 人民币中文大写()
   
2. '功能：全文查找数字元/大写在前c=1/大写在后c=0
   
3. Dim n$, i&, s1$, s2$, s3$, Caps$, c&
   
4. Selection.HomeKey Unit:=wdStory　　　'光标定位至文档开始处, 此句不可少
   
5. 　　c = 1
   
6. With Selection.Find　　　　　　　　　　　'Find的父对象是.Selection
   
7. 　　.ClearFormatting　　　　　　　　　　'清除拟查找的格式
   
8. 　　.Text = "[0-9." & Chr(32) & Chr(41377) & ChrW(160) & Chr(9) & ",，]{1,}元"　'小写模式串
   
9. 　　.Forward = False　　　　　　　　　　'往前查找为假时, 则执行往回查找
   
10. 　　.Wrap = wdFindContinue　　　　　　　'绕回查找并全文搜索, 当再次查到文首或文尾时停止
    
11. 　　.MatchWildcards = True　　　　　　 '匹配通配符
    
12. 　　 Do While .Execute　　　　　　　　　'查找成功往下执行(无参数时, 只查找不替换)
    
13. 　　　　With .Parent　　　　　　　　　　 '父对象被重新定义为找到的对象
    
14. 　　　　　　　.MoveEnd 1, -1　　　　　　'去掉小写尾部的字符"元"
    
15. 　　　　　　　n = .Text　　　　　　　　　'取得父对象的文本(即小写金额)
    
16. 　　　　　　　If n Like "*.*.*" Then .Font.Color = wdColorRed: GoTo sk　'数字含有两个小数点就退出
    
17. 　　　　　　　With CreateObject("VBScript.RegExp")　　　　　　　　'创建正则表达式对象
    
18. 　　　　　　　　　.Global = True　　　　　　　　　　　　　　　　　　　'全局替换
    
19. 　　　　　　　　　'下列正则表达式对小写金额作规范处理
    
20. 　　　　　　　　　.Pattern = "[\u0020\u3000\u0009\u00A0,，]"　　　'去掉空格及数字分节号
    
21. 　　　　　　　　　 n = .Replace(n, "")　　　　　　　　　　　　　　　　'替换成空串
    
22. 　　　　　　　　　 n = Format(n*100, "000")　　　　　　　　　　　　'化成整数不足3位左边补0"
    
23. 　　　　　　　　　 If Len(n) > 15 Then MsgBox "数字超出15位啦! ": GoTo sk　'金额超过万亿位就退出
    
24. 　　　　　　　　　' 下列For语句将数字逐位转换成大写
    
25. 　　　　　　　　　 Caps = ""
    
26. 　　　　　　　　　 For i = 0 To Len(n) - 1　　　　　　　　　　　　　　　　　　'按数字位数循环替换
    
27. 　　　　　　　　　　　s1 = Mid(n, Len(n) - i, 1)　　　　　　　　　　　　　　　'从末位起逐位取数字
    
28. 　　　　　　　　　　　s2 = Mid("零壹贰叁肆伍陆柒捌玖", s1 + 1, 1)　　　　　　'取相应数字的大写
    
29. 　　　　　　　　　　　s3 = Mid("分角元拾佰仟万拾佰仟亿拾佰仟万", i + 1, 1)　 '左边起逐位取单位大写
    
30. 　　　　　　　　　　　Caps = s2 & s3 & Caps　　　　　　　　　　　　　　　　　'连接数字大写与单位大写
    
31. 　　　　　　　　　 Next i
    
32. 　　　　　　　　　' 下列正则表达式去掉多余的"零", 模式字串安排极具技巧性
    
33. 　　　　　　　　　.Pattern = "(零[仟佰拾角分])+零?"　　　　　　'查找“零仟,零仟零,零仟零佰,……”等等
    
34. 　　　　　　　　　 Caps = .Replace(Caps, "零")　　　　　　　　'替换为“零”
    
35. 　　　　　　　　　.Pattern = "零?([亿万元])(零万)?"　　　　　　 '查找“零亿,零万,零元,零亿零万”
    
36. 　　　　　　　　　 Caps = .Replace(Caps, "$1")　　　　　　　　'替换为“亿/万/元”
    
37. 　　　　　　　　　.Pattern = "([亿万仟佰拾])([亿万元])([壹贰叁肆伍陆柒捌玖])"
    
38. 　　　　　　　　　 Caps = .Replace(Caps, "$1$2零$3")　　　　　'“亿/万/元”位=0时添加“零”
    
39. 　　　　　　　　　.Pattern = "^元零?(.[角分])"　　　　　　　　　'金额<1时的角分大写
    
40. 　　　　　　　　　 Caps = .Replace(Caps, "$1")
    
41. 　　　　　　　　　.Pattern = "(^元)(零$)|零$"　　　　　　　　　'金额=0/分位=0时的大写
    
42. 　　　　　　　　　 Caps = .Replace(Caps, "$2$1整")　　　　　 '金额≠0时变量$1/$2为空值
    
43. 　　　　　　　End With
    
44. 　　　　　　　' 下列IF语句插入人民币大写
    
45. 　　　　　　　If c = 1 Then
    
46. 　　　　　　　　 .InsertBefore Text:="人民币" & Caps　　　　　'大写插在数字左边
    
47. 　　　　　　　Else
    
48. 　　　　　　　　 .MoveEnd　　　　　　　　　　　　　　　　　　　'无参数时尾部扩展一字符
    
49. 　　　　　　　　 .InsertAfter Text:="（人民币" & Caps & "）"　 '大写插在数字右边
    
50. 　　　　　　　End If
    
51. 　　　　　　 .End = .Start　　　'将选定文本折叠至起始位置
    
52. sk:　　 End With
    
53. 　　 Loop　　　　　　　　　　　'循环查找下一个小写金额
    
54. End With
    
55. End Sub

复制代码

下面对正则表达式模式字串进行说明：

① 第一次去零：模式字串“(零[仟佰拾角分])+零?”，将 “零仟”、“零佰”、“零拾”、“零角”、“零分”、“零仟零”、“零佰零”、“零拾零”、“零仟零佰”、“零佰零拾”、“零角零分”、“零仟零佰零”、“零佰零拾零” 等字串替换为“零”。

② 第二次去零：模式字串“零?([亿万元])(零万)?”，将 “零亿”、“零零亿”、“零亿零万”替换为“亿”，将“零万”、“零零万”替换为“万”，将“零元”、“零零元” 替换为“元”。

③ 第三次去零：模式字串“([亿万仟佰拾])([亿万元])([壹贰叁肆伍陆柒捌玖])”，对于 “万亿”、“仟亿”、“佰亿”、“拾亿”、“仟万”、“佰万”、“拾万”、“亿元”、“万元”、“仟元”、“佰元”、“拾元” 之后紧接大写数字“壹/贰/叁/肆/伍/陆/柒/捌/玖”之一的，就要在大写数字之前添加“零”。模式字串中，第一个圆括号代表$1，第二个圆括号代表$2，第三个圆括号代表$3。

④ 第四次去零：模式字串“^元零?(.[角分])”，当金额数字<1元时，截取角分位的大写。英文句点代表任意字符，圆括号起截取作用，^表示以字符“元”打头的大写金额，?表示前一字符“零”或有或无两种情况均存在。模式字串的作用，是对<1的金额，去掉其大写中的 “元” 或 “元零” 等字符。

⑤ 第五次去零：模式字串“(^元)(零$)|零$”(竖线为“或”之意)，当金额=0时，第二次去零已被转换成“元零”，故须将“元零”再次转换成“零元”并添加“整”字。除此之外其他≠0的大写金额，当分位=0时，将尾部“零”替换为“整”。对于≠0的大写金额，因与模式字串“(^元)(整$)”不匹配，故变量$1、$2=空值，所以，尾部“零”替换为“整”不受影响。

补充内容 (2019-7-16 23:42):
“第二次去零”的说明还是有点错误，现更正如下：
② 第二次去零：模式字串“零?([亿万元])(零万)?”，将 “零亿”、“零亿零万”、“亿零万”替换为“亿”，将“零万”替换为“万”，将“零元”替换为“零”。

补充内容 (2019-7-16 23:43):
又错了。“零元”应该是替换为“元”。

413191246se

楼上朋友，我对你——刮目相看！
正则，我因为不懂，所以放弃了！不是它不好，是我没学会。
你的代码，有时间我再仔细拜读！谢谢！

相见是缘8

qdnzlh 发表于 2019-7-13 21:46
我也做一点贡献，在楼主代码的基础上修改的。

代码解析：[1]&#8194;本代码对楼主413191246se的代码进行 ...

413191246se 老师的代码以是不简单，而 qdnzlh 老师的代码更是锦上添花！更难得的是代码不仅带有注释，还进行了讲解及编写代码的思路和结构上为什么要这么用，在这个论坛上实属罕见，真是我等初学者的福音和榜样！曾看到过守柔总版主及以前一批大神们编写的代码也大多都带有注释。记得硅谷有一位顶级大神说过，编写代码不带注释，不是一名合格的程序员！
感谢 qdnzlh 老师的付出！为qdnzlh 老师点赞！！！

小花鹿

论坛本来就有现成的自定义函数，直接调用就行，何必自已写
Function 人民币大写(M)
y = Int(Round(100 * Abs(M)) / 100)
j = Round(100 * Abs(M) + 0.00001) - y * 100
f = Round((j / 10 - Int(j / 10)) * 10)
A = IIf(y < 1, "", Application.Text(y, "[DBNum2]") & "元")
b = IIf(j > 9.4, Application.Text(Int(j / 10), "[DBNum2]") & "角", IIf(y < 1, "", IIf(f > 0.4, "零", "")))
c = IIf(f < 1, "整", Application.Text(Round(f, 0), "[DBNum2]") & "分")
人民币大写 = IIf(Abs(M) < 0.005, "", IIf(M < 0, "负" & A & b & c, A & b & c))
End Function

Function DxToN(ss)
    For i% = 1 To 9
        ss = Replace(ss, Mid("壹贰叁肆伍陆柒捌玖", i, 1), i)
        ss = Replace(ss, Mid("一二三四五六七八九", i, 1), i)
    Next
    For i% = Len(ss) To 1 Step -1
        s$ = Mid$(ss, i, 1)
        x% = InStr("分角圆拾佰仟万拾佰仟亿拾佰仟兆", s)
        If x = 0 Then x% = InStr("分毛元十百千萬十百千億十百千兆", s)
        If x Then j% = IIf(j% < x, x, ((j - 3) \ 4) * 4 + x)
        If Val(s) Then M# = M# + (s & String(j - 1, "0")) / 100
    Next
    DxToN = Round(M, 2)
    If InStr(ss, "-") Or InStr(ss, "负") Then DxToN = -DxToN
End Function

qdnzlh

小花鹿 发表于 2019-7-14 09:31
论坛本来就有现成的自定义函数，直接调用就行，何必自已写
Function 人民币大写(M)
y = Int(Round(100 *  ...

你提供的这个自定义函数调用了Excel 的工作表函数Text()，在Word文本中能行吗？我是没试过，但估计可能不行。

daibao88

从论坛收集来的一个
Public Function N2RMB(number)
    Dim Curr$, Csing$, n%, CurrLength%, s1$, s2$, s3$, zf As Boolean
    If Val(number) < 0 Then zf = True
    Curr = Format(Abs(Val(number)) * 100, "0")
    CurrLength = Len(Curr)
    For n = 0 To CurrLength - 1
        s1 = Mid(Curr, CurrLength - n, 1)
        s2 = Mid("零壹贰叁肆伍陆柒捌玖", s1 + 1, 1)
        s3 = Mid("分角元拾佰仟万拾佰仟亿拾佰仟", n + 1, 1)
        Csing = s2 & s3 & Csing
    Next
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(零[仟佰拾角分]+)+零?"
        Csing = .Replace(Csing, "零")
        .Pattern = "零?([亿万元])(零万)?|^零$"
        Csing = .Replace(Csing, "$1")
        .Pattern = "零$"
        Csing = .Replace(Csing, "整")
    End With
    If zf = True Then Csing = "负" & Csing
    N2RMB = Csing
End Function

qdnzlh

楼上这位坛友搜来的这个自定义函数，看上去确实比较短小精悍。
不过经测试，发现还是有一些问题。
我测试了以下三笔金额：
①200020002000.22元 -- 转换为：贰仟亿贰仟万贰仟元贰角贰分
②0.00元 -- 转换为：(空白)
③200,020,002,000.22元 -- 转换为：贰佰元整

第一笔金额：贰仟亿与贰仟万之间、贰仟万与贰仟元之间、贰仟元与贰角之间，是不是需要添加“零”呢？
小学课本在教学生读写人民币数字时，是需要添加零的。
不过，我没找到人民银行对人民币读写的规定，如果人民银行规定是可以的，那就可以。
第二笔金额：0.00元，转换成空白，这个应该不行吧？！
第三笔金额：两千多亿元转换成两百元整，这个就根本不行了。这是未对小写金额进行格式化所致。

413191246se

正确填写票据和结算凭证的基本规定
（人行支付结算办法规定）
　　银行、单位和个人填写的各种票据和结算凭证是办理支付结算和现金收付的重要依据，直接关系到支付结算的准确、及时和安全。票据和结算凭证是银行、单位和个人凭以记载帐务的会计凭证，是记载经济业务和明确经济责任的一种书面证明。因此，填写票据和结算凭证，必须做到标准化、规范化，要要素齐全、数字正确、字迹清晰、不错漏、不潦草，防止涂改。
　　一、中文大写金额数字应用正楷或行书填写，如壹（壹）、贰（贰）、叁（叁）、肆（肆）、伍（伍）、陆（陆）、柒、捌、玖、拾、佰、仟、万（万）、亿、元、角、分、零、整（正）等字样。不得用一、二（两）、三、四、五、六、七、八、九、十、念、毛、另（或0）填写，不得自造简化字。如果金额数字书写中使用繁体字，如贰、陆、亿、万、圆的，也应受理。
　　二、中文大写金额数字到"元"为止的，在"元"之后，应写"整"（或"正"）字，在"角"之后可以不写"整"（或"正"）字。大写金额数字有"分"的，"分"后面不写"整"（或"正"）字。
　　三、中文大写金额数字前应标明"人民币"字样，大写金额数字有"分"的，"分"后面不写"整"（或"正"）字。
　　四、中文大写金额数字前应标明"人民币"字样，大写金额数字应紧接"人民币"字样填写，不得留有空白。大写金额数字前未印"人民币"字样的，应加填"人民币"三字。在票据和结算凭证大写金额栏内不得预印固定的"仟、佰、拾、万、仟、佰、拾、元、角、分"字样。
　　五、阿拉伯小写金额数字中有"0"时，中文大写应按照汉语语言规律、金额数字构成和防止涂改的要求进行书写。
　　举例如下：
　　（一）阿拉伯数字中间有"0"时，中文大写金额要写"零"字。如￥1，409. 50，应写成人民币壹仟肆佰零玖元伍角。
　　（二）阿拉伯数字中间连续有几个"0"时，中文大写金额中间可以只写一个"零"字。如￥6，007.14，应写成人民币陆仟零柒元壹角肆分。
　　（三）阿拉伯金额数字万位或元位是"0"，或者数字中间连续有几个"0"，万位、元位也是"0"，但千位、角位不是"0"时，中文大写金额中可以只写一个零字，也可以不写"零"字。如￥1，680.32，应写成人民币壹仟陆佰捌拾元零叁角贰分，或者写成人民币壹仟陆佰捌拾元叁角贰分；又如￥107，000.53，应写成人民币壹拾万柒仟元零伍角叁分，或者写成人民币壹拾万零柒仟元伍角叁分。
　　（四）阿拉伯金额数字角位是"0"，而分位不是"0"时，中文大写金额"元"后面应写"零"字。如￥16，409.02，应写成人民币壹万陆仟肆佰零玖元零贰分；又如￥325.04，应写成人民币叁佰贰拾伍元零肆分。
　　六、阿拉伯小写金额数字前面，均应填写人民币符号"￥"（或草写： ）。阿拉伯小写金额数字要认真填写，不得连写分辩不清。
　　七、票据的出票日期必须使用中文大写。为防止变造票据的出票日期，在填写月、日时，月为壹、贰和壹拾的，日为壹至玖和壹拾、贰拾和叁拾的，应在其前加"零"；日为拾壹至拾玖的，应在其前加"壹"。如1月15日，应写成零壹月壹拾伍日。再如10月20日，应写成零壹拾月零贰拾日。
　　八、票据出票日期使用小写填写的，银行不予受理。大写日期未按要求规范填写的，银行可予受理，但由此造成损失的，由出票人自行承担。

qdnzlh

根据人行的这个规定，那 “贰仟亿贰仟万贰仟元贰角贰分” 这个大写也是允许的啦！只是总感觉读起来有一点别扭。
如果能把0.00元的问题解决了，那坛友daibao88搜来的这个自定义函数代码就是最简洁的啦。
有时间我再思考下，再看能不能解决0.00元的问题。

当然，我不是程序员，只是VBA爱好者而已。人民币小写转大写的应用场景其实也很少，一篇文章中起码要有10笔以上小写金额要转换才有实际价值，10笔以下的转换意义就不是很大，还不如用搜狗输入法直接打小写出大写来的快些。

人民币小写转大写代码，比较适合VBA初学者作为编程实例进行学习，帮助拓展编程思路。