人民币中文大写（宏）- 最新修正！

13907933959

413191246se 发表于 2016-9-12 22:31
谢谢 loquat 朋友！
139：你 5 楼的要求，当然是能办到的，但是，到底是你对呢？还是我对呢？这个不好说了 ...

师傅好！
能不能先满足我5楼的要求？把代码小数字的部分先给优化一下，我想先把帐本小数字的这部分整理完。谢谢师傅！

413191246se

* 本宏对三位小数或以上，自动四舍五入为二位小数。
* 本宏对原文数字（小写金额）只设置格式，并不改变一个字符（不删除/不增加）。
* 顺便对徒弟 139 说一声：带不带“零”字，在转换时要看原数字是否有“0”，不可人为添加。
* 请各位朋友，有时间可以认真学习一下《正确填写票据和结算凭证的基本规定》一文。

13907933959

师傅好！
测试小于10亿的数字，准确无误，代码来得真不容易！！！师傅辛苦！！！

13907933959

413191246se 发表于 2016-9-22 02:26
* 本宏对三位小数或以上，自动四舍五入为二位小数。
* 本宏对原文数字（小写金额）只设置格式，并不改变一 ...

师傅好！
测试小于10亿的数字，准确无误，代码来得真不容易！！！师傅辛苦！！！

413191246se

顶以更新！
....最近，因为全新重写了代码，重新修正了算法，并重新键入了大约 3700 行测试数字，每天用于此宏的测试时间并不多，致使最近从 9月22日一直到迁延到现在才完成本宏，主要是10亿以上百亿、千亿数字，实际用处并不大，但没有似乎还不行，工夫全耽误在百亿、千亿这些数字上面了，总算完成此宏！（此宏终结！）
....139 徒弟请注意：明天我再把《人民币中文小写》代码再更新一遍发到楼下！

duquancai

413191246se 发表于 2016-10-16 22:09
顶以更新！
....最近，因为全新重写了代码，重新修正了算法，并重新键入了大约 3700 行测试数字，每天用于 ...

感觉用正则表达式来做，应该可行，且速度也很快！

13907933959

413191246se 发表于 2016-10-16 22:09
顶以更新！
....最近，因为全新重写了代码，重新修正了算法，并重新键入了大约 3700 行测试数字，每天用于 ...

师傅好！
师傅您真让徒弟感动！！！

413191246se

....谢谢 段先生！你是 VBA & 正则 高手，相信能办到！
....其实，我是 VBA 菜鸟，勉强会编一些小宏，主要是不想求高手，自己能解决的就自己编了，算法不行，功力不行，但还算自给自足。
....谢谢 徒弟 139 ！
下面是《人民币中文小写》的代码，由《人民币中文大写》加了一段转换代码而成，不知对不对：

1. Sub 人民币中文小写()
   
2. '功能：全文查找数字元（也可单选数字）转换为人民币中文小写
   
3. 
   
4.     Dim i As String, j As String, k As String, x As String, y As String, u As Long, v As Long, n As Long, s As Long
   
5.     x = MsgBox("小写是否放在数字前面？（否则后面）", vbYesNoCancel + vbExclamation, "人民币中文小写")
   
6.     If x = vbYes Then
   
7.         n = 1
   
8.     ElseIf x = vbNo Then
   
9.         n = 0
   
10.     Else
    
11.         End
    
12.     End If
    
13. 
    
14. '全文/单个
    
15.     If Selection.Type <> wdSelectionIP Then
    
16.         Do While Selection.Characters.First Like "[!0-9０-９]"
    
17.             Selection.MoveStart Unit:=wdCharacter, Count:=1
    
18.         Loop
    
19.         Do While Not (Selection.Characters.Last Like "[0-9０-９.,， 　]" Or Selection.Characters.Last Like ChrW(160))
    
20.             Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
21.         Loop
    
22.         Selection.MoveEnd Unit:=wdCharacter, Count:=1
    
23.         If Selection Like "*[!元]" Then
    
24.             Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
25.             Selection.InsertAfter Text:="元"
    
26.         End If
    
27.         s = 1
    
28.         GoTo SingleNum
    
29.     End If
    
30. 
    
31. '全文查找数字元
    
32.     Selection.HomeKey Unit:=wdStory
    
33.     Selection.Find.ClearFormatting
    
34.     Do While Selection.Find.Execute(findtext:="^#", Forward:=True)
    
35.         Do While Selection.Characters.Last Like "[0-9０-９.,， 　]" Or Selection.Characters.Last Like ChrW(160)
    
36.             Selection.MoveEnd Unit:=wdCharacter, Count:=1
    
37.         Loop
    
38. SingleNum:
    
39.         If Selection Like "*元" Then
    
40.             '格式处理
    
41.             Selection.Font.Bold = True '加粗
    
42.             Selection.Font.Color = wdColorBlue '蓝色
    
43.             Selection.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
44. 
    
45.             '选定数字
    
46.             Selection.MoveEnd Unit:=wdCharacter, Count:=-1
    
47.             k = "万仟佰拾亿仟佰拾万仟佰拾元空角分"
    
48.             i = Selection
    
49. 
    
50.             '规范数字
    
51.             i = Replace(i, ChrW(160), "") '替换不间断空格
    
52.             i = Replace(i, " ", "") '替换半角空格
    
53.             i = Replace(i, "　", "") '替换全角空格
    
54.             i = Replace(i, ",", "") '替换英文逗号
    
55.             i = Replace(i, "，", "") '替换中文逗号
    
56.             i = Format(i) '删除数字前后无效零/小数点
    
57. 
    
58.             '单个数字
    
59.             If s = 1 Then
    
60.                 i = StrConv(i, vbNarrow) '全角转半角
    
61.                 Dim a
    
62.                 a = Val(i) '数值型
    
63.                 If Len(i) <> Len(a) Then MsgBox "非纯数字，无法转换！！！", vbOKOnly + vbCritical, "人民币中文大写": End
    
64.             End If
    
65. 
    
66.             If i Like ".*" Then i = "0" & i
    
67. 
    
68.             '错误报警
    
69.             If Selection Like "*.*.*" Or Val(i) > 999999999999.99 Then
    
70.                 Selection.Font.Color = wdColorRed '红色
    
71.                 Selection.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
72.                 GoTo Skip
    
73.             End If
    
74. 
    
75.             '强制格式
    
76.             If i Like "*?.??" Then
    
77.             ElseIf i Like "*?.?" Then
    
78.                 i = i & "0"
    
79.             ElseIf i Like "*?.???*" Then
    
80.                 i = Format(i, "0.00")
    
81.             Else
    
82.                 i = i & ".00"
    
83.             End If
    
84. 
    
85.             '核心代码
    
86.             v = Len(i)
    
87.             k = Right(k, v)
    
88.             u = 0
    
89.             y = ""
    
90.             Do
    
91.                 u = u + 1
    
92.                 j = Mid(i, u, 1) & Mid(k, u, 1)
    
93.                 y = y & j
    
94.             Loop Until u = v
    
95.             i = y
    
96. 
    
97.             '基本替换
    
98.             i = Replace(i, "1", "壹")
    
99.             i = Replace(i, "2", "贰")
    
100.             i = Replace(i, "3", "叁")
     
101.             i = Replace(i, "4", "肆")
     
102.             i = Replace(i, "5", "伍")
     
103.             i = Replace(i, "6", "陆")
     
104.             i = Replace(i, "7", "柒")
     
105.             i = Replace(i, "8", "捌")
     
106.             i = Replace(i, "9", "玖")
     
107.             i = Replace(i, "0", "零")
     
108.             i = Replace(i, ".", "点")
     
109.             i = Replace(i, "点空", "")
     
110. 
     
111.             '零字替换
     
112.             i = Replace(i, "零仟", "零")
     
113.             i = Replace(i, "零佰", "零")
     
114.             i = Replace(i, "零拾", "零")
     
115. 
     
116.             Do While i Like "*零零*"
     
117.                 i = Replace(i, "零零", "零")
     
118.             Loop
     
119. 
     
120.             i = Replace(i, "零亿", "亿零")
     
121.             i = Replace(i, "零万", "万零")
     
122.             i = Replace(i, "零元", "元零")
     
123. 
     
124.             Do While i Like "*零零*"
     
125.                 i = Replace(i, "零零", "零")
     
126.             Loop
     
127. 
     
128.             i = Replace(i, "零角零分", "整")
     
129.             i = Replace(i, "零角", "零")
     
130.             i = Replace(i, "零分", "")
     
131. 
     
132.             If i Like "元零*" Then i = Replace(i, "元零", "")
     
133.             If i = "元整" Then i = "零" & i
     
134. 
     
135.             If i Like "*万零元*" And Val(i) < 100000000 Then i = Replace(i, "万零元", "万元") '10万<=X<1亿
     
136.             i = Replace(i, "亿万", "亿")
     
137. 
     
138.             If i Like "*亿零万*" Then i = Replace(i, "零万", "") '>=10亿
     
139. 
     
140.             '基本替换（小写）
     
141.             i = Replace(i, "壹", "一")
     
142.             i = Replace(i, "贰", "二")
     
143.             i = Replace(i, "叁", "三")
     
144.             i = Replace(i, "肆", "四")
     
145.             i = Replace(i, "伍", "五")
     
146.             i = Replace(i, "陆", "六")
     
147.             i = Replace(i, "柒", "七")
     
148.             i = Replace(i, "捌", "八")
     
149.             i = Replace(i, "玖", "九")
     
150. 
     
151.             '转换结果
     
152.             i = "（人民币" & i & "）"
     
153.             If n = 1 Then Selection.InsertBefore Text:=i Else Selection.MoveEnd Unit:=wdCharacter, Count:=1: Selection.InsertAfter Text:=i
     
154.             If s = 1 Then End
     
155.         End If
     
156. Skip:
     
157.         Selection.MoveRight Unit:=wdCharacter, Count:=1
     
158.     Loop
     
159. End Sub

复制代码

13907933959

413191246se 发表于 2016-10-17 20:43
....谢谢 段先生！你是 VBA & 正则 高手，相信能办到！
....其实，我是 VBA 菜鸟，勉强会编一些小宏，主要 ...

师傅好！
师傅辛苦！师傅辛辛辛辛苦！师傅辛苦！！！
刚测试了，转换正确。
师傅、中文数字小写“零”，好象是这个“○”。

413191246se

顶以更新！
.
139 请注意：第18楼第34行代码，要在最后的括号前面加上下面一句
,MatchWildCards:=False
关于是“零”还是“○”的问题，你自己查一下网络吧，不过我觉得好像是“零”——如果认为是“○”，可在第150行中添加代码 i = Replace(i, "零", "○")