人民币中文大写转阿拉伯数字（宏）v1.00_Beta

413191246se

***简介：《人民币中文大写转阿拉伯数字》宏（v1.00_Beta），由于本人水平较低，未达到完美程度，但轻量级的中文大写金额（如10亿以下）基本比较正确，现在有些10-100亿的金额尚未解决（未解决的在附件《疑难》中），最大识别金额为壹仟亿元整！***如有需要的朋友（包括徒弟139），在你的实际工作中如果数值不超过10亿元，可以应用此宏，但建议转换后务必认真校对，以确保数据完全。
***在运行本宏的过程中，请不要操作鼠标和键盘，直到程序完成。
***怎么消除转换后的重波浪线呢？很简单，只须：编辑菜单/全选/点击工具栏上的下划线按钮两次（中间要稍等一下）即可。
测试附件： demo 人民币中文大写转阿拉伯数字（测试附件）.rar (10.36 KB, 下载次数: 29)

2016-9-12 22:22 上传

点击文件名下载附件

1. Sub 人民币中文大写转阿拉伯数字()
   
2.     Dim n As Long, i As String, j As String
   
3.     If MsgBox("阿拉伯数字是否放在大写前面？（否则后面）", vbYesNo + vbExclamation, "人民币中文大写转阿拉伯数字") = vbYes Then n = 1 Else n = 0
   
4.     ActiveDocument.Paragraphs.Last.Range.InsertAfter Text:=vbCr & "`"
   
5.     Selection.HomeKey unit:=wdStory
   
6.     Do
   
7.         Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
   
8.         If Selection = "`" Then Exit Do
   
9.         Do While Selection.Characters.Last Like "[壹贰叁肆伍陆柒捌玖零亿万仟佰拾元圆角分整]"
   
10.             Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
    
11.             If Selection.Characters.Last Like "[!壹贰叁肆伍陆柒捌玖零亿万仟佰拾元圆角分整]" Then
    
12.                 Selection.MoveEnd unit:=wdCharacter, Count:=-1
    
13. 
    
14.                 If Len(Selection) = 1 Then Exit Do
    
15.                 Do While Selection Like "[亿万仟佰元圆角分整]*"
    
16.                     Selection.MoveStart unit:=wdCharacter, Count:=1
    
17.                 Loop
    
18.                 Do While Selection Like "*零"
    
19.                     Selection.MoveEnd unit:=wdCharacter, Count:=-1
    
20.                 Loop
    
21. 
    
22.                 If Selection Like "*仟*亿*元*" And Selection <> "壹仟亿元整" Then
    
23.                     Selection.Font.Color = wdColorRed '红色
    
24.                     Selection.Font.Bold = True '加粗
    
25.                     Selection.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
26.                     GoTo Skip
    
27.                 End If
    
28. 
    
29. '                Selection.Font.Bold = True '加粗
    
30. '                Selection.Font.Color = wdColorBlue '蓝色
    
31.                 Selection.Font.Underline = wdUnderlineWavyHeavy '重波浪线
    
32. Skip:
    
33.                 i = Selection.Text
    
34.                 i = Replace(i, "圆", "元")
    
35.                 If i Like "*[!元角分整]" Then i = i & "元整"
    
36.                 If i Like "*元" Then i = i & "整"
    
37. '
    
38.                 If i Like "*佰亿零?仟万*" Then i = Replace(i, "佰亿零", "00")
    
39.                 If i Like "*佰亿零?佰万*" Then i = Replace(i, "佰亿零", "000")
    
40.                 If i Like "*佰亿零?拾万*" Then i = Replace(i, "佰亿零", "0000")
    
41.                 If i Like "*佰亿零?万*" Then i = Replace(i, "佰亿零", "00000")
    
42.                 If i Like "*佰亿零?仟*" Then i = Replace(i, "佰亿零", "000000")
    
43.                 If i Like "*佰亿零?佰*" Then i = Replace(i, "佰亿零", "0000000")
    
44.                 If i Like "*佰亿零?拾*" Then i = Replace(i, "佰亿零", "00000000")
    
45.                 If i Like "*佰亿零*" Then i = Replace(i, "佰亿零", "000000000")
    
46. 
    
47.                 If i Like "*拾亿零?仟万*" Then i = Replace(i, "拾亿零", "0")
    
48.                 If i Like "*拾亿零?佰万*" Then i = Replace(i, "拾亿零", "00")
    
49.                 If i Like "*拾亿零?拾万*" Then i = Replace(i, "拾亿零", "000")
    
50.                 If i Like "*拾亿零?万*" Then i = Replace(i, "拾亿零", "0000")
    
51.                 If i Like "*拾亿零?仟*" Then i = Replace(i, "拾亿零", "00000")
    
52.                 If i Like "*拾亿零?佰*" Then i = Replace(i, "拾亿零", "000000")
    
53.                 If i Like "*拾亿零?拾*" Then i = Replace(i, "拾亿零", "0000000")
    
54.                 If i Like "*拾亿零*" Then i = Replace(i, "拾亿零", "00000000")
    
55. 
    
56.                 If i Like "*亿零?佰万*" Then i = Replace(i, "亿零", "0")
    
57.                 If i Like "*亿零?拾万*" Then i = Replace(i, "亿零", "00")
    
58.                 If i Like "*亿零?万*" Then i = Replace(i, "亿零", "000")
    
59.                 If i Like "*亿零?仟*" Then i = Replace(i, "亿零", "0000")
    
60.                 If i Like "*亿零?佰*" Then i = Replace(i, "亿零", "00000")
    
61.                 If i Like "*亿零?拾*" Then i = Replace(i, "亿零", "000000")
    
62.                 If i Like "*亿零*" Then i = Replace(i, "亿零", "0000000")
    
63. 
    
64.                 If i Like "*仟万零?仟*" Then i = Replace(i, "仟万零", "000")
    
65.                 If i Like "*仟万零?佰*" Then i = Replace(i, "仟万零", "0000")
    
66.                 If i Like "*仟万零?拾*" Then i = Replace(i, "仟万零", "00000")
    
67.                 If i Like "*仟万零*" Then i = Replace(i, "仟万零", "000000")
    
68. 
    
69.                 If i Like "*佰万零?仟*" Then i = Replace(i, "佰万零", "00")
    
70.                 If i Like "*佰万零?佰*" Then i = Replace(i, "佰万零", "000")
    
71.                 If i Like "*佰万零?拾*" Then i = Replace(i, "佰万零", "0000")
    
72.                 If i Like "*佰万零*" Then i = Replace(i, "佰万零", "00000")
    
73. 
    
74.                 If i Like "*拾万零?仟*" Then i = Replace(i, "拾万零", "0")
    
75.                 If i Like "*拾万零?佰*" Then i = Replace(i, "拾万零", "00")
    
76.                 If i Like "*拾万零?拾*" Then i = Replace(i, "拾万零", "000")
    
77.                 If i Like "*拾万零*" Then i = Replace(i, "拾万零", "0000")
    
78. 
    
79.                 If i Like "*万零?佰*" Then i = Replace(i, "万零", "0")
    
80.                 If i Like "*万零?拾*" Then i = Replace(i, "万零", "00")
    
81.                 If i Like "*万零*" Then i = Replace(i, "万零", "000")
    
82. 
    
83.                 If i Like "*仟零?拾*" Then i = Replace(i, "仟零", "0")
    
84.                 If i Like "*仟零*" Then i = Replace(i, "仟零", "00")
    
85. 
    
86.                 If i Like "*?万亿元*" Then i = Replace(i, "万亿", "000000000000")
    
87.                 If i Like "*?仟亿元*" Then i = Replace(i, "仟亿", "00000000000")
    
88.                 If i Like "*?佰亿元*" Then i = Replace(i, "佰亿", "0000000000")
    
89.                 If i Like "*?拾亿元*" Then i = Replace(i, "拾亿", "000000000")
    
90.                 If i Like "*?亿元*" Then i = Replace(i, "亿", "00000000")
    
91.                 If i Like "*?仟万元*" Then i = Replace(i, "仟万", "0000000")
    
92.                 If i Like "*?佰万元*" Then i = Replace(i, "佰万", "000000")
    
93.                 If i Like "*?拾万元*" Then i = Replace(i, "拾万", "00000")
    
94.                 If i Like "*?万元*" Then i = Replace(i, "万", "0000")
    
95.                 If i Like "*?仟元*" Then i = Replace(i, "仟", "000")
    
96.                 If i Like "*?佰元*" Then i = Replace(i, "佰", "00")
    
97.                 If i Like "*?拾元*" Then i = Replace(i, "拾", "0")
    
98. 
    
99.                 i = Replace(i, "元整", "")
    
100. 
     
101.                 If Not (i Like "*元零?分*") Then i = Replace(i, "元零", "元")
     
102.                 If i Like "*元?角" Then i = Replace(i, "角", "0")
     
103.                 If i Like "?角?分" Then i = "0." & i
     
104.                 If i Like "?角" Then i = "0." & i & "0"
     
105.                 If i Like "?分" Then i = "0.0" & i
     
106. 
     
107.                 i = Replace(i, "壹", "1")
     
108.                 i = Replace(i, "贰", "2")
     
109.                 i = Replace(i, "叁", "3")
     
110.                 i = Replace(i, "肆", "4")
     
111.                 i = Replace(i, "伍", "5")
     
112.                 i = Replace(i, "陆", "6")
     
113.                 i = Replace(i, "柒", "7")
     
114.                 i = Replace(i, "捌", "8")
     
115.                 i = Replace(i, "玖", "9")
     
116.                 i = Replace(i, "零", "0")
     
117.                 i = Replace(i, "亿", "")
     
118.                 i = Replace(i, "万", "")
     
119.                 i = Replace(i, "仟", "")
     
120.                 i = Replace(i, "佰", "")
     
121.                 i = Replace(i, "拾", "")
     
122.                 i = Replace(i, "元", ".")
     
123.                 i = Replace(i, "角", "")
     
124.                 i = Replace(i, "分", "")
     
125.                 i = Replace(i, "整", "")
     
126. 
     
127.                 j = "（￥：" & i & "元）"
     
128.                 If n = 1 Then Selection.InsertBefore Text:=j Else Selection.InsertAfter Text:=j
     
129.                 Exit Do
     
130.             End If
     
131.         Loop
     
132.         Selection.MoveRight unit:=wdCharacter, Count:=1
     
133.     Loop
     
134.     ActiveDocument.Paragraphs.Last.Range.Delete
     
135.     MsgBox "处理完毕！！！！！！" & vbCr & "请注意！中文大写金额最大不得超过<壹仟亿元整>，否则转换将不正确！" & vbCr & _
     
136.     "请检查文中是否有<红色/加粗/重波浪线>金额（超过限制），手动转换！" _
     
137.     & vbCr & "本宏为 v1.00 Beta 版本，数据超过10亿可能转换不正确，最大不得超过1千亿！", vbOKOnly + vbExclamation, "人民币中文大写转阿拉伯数字"
     
138. End Sub

复制代码

13907933959

师傅好！

刚在附件内测试了“人民币中文大写转阿拉伯数字”的宏，发现还有几处转换后的阿拉伯数字好象不太准确。

gbgbxgb

13907933959

gbgbxgb 发表于 2016-9-10 22:32

前辈好！

感谢前辈多次出手相助！

看到前辈录制的屏幕演示，能将阿拉伯数字转化为中文大写数字，但不知所有的阿拉伯数字都能完美的转化？

还有前辈可能没有注意到，上面帖子是要将中文大写数字转化为阿拉伯数字。

请前辈查看下面的附件，谢谢！

413191246se

139：最近经过几天的努力，当然我水平不高，完善不少！现在还有一些疑难数据未攻克（就是佰亿元量级的数据未攻克，致使数据不正确！如果数据是佰亿量级以下的，可能会正确，但转换后也需要确认检查！），我现在发上来最新版本宏代码和测试附件（你的附件不如我的附件，看我的吧！今天发现进坛又换验证方式了，中午没进来，为防以后进不来，我现在留下我的联系邮箱，有事给我发邮件，万一我上不来的话！——我的电子邮箱：ln1400014884@163.com）： macro 人民币中文大写转阿拉伯数字 v0.99.1.rar (10.66 KB, 下载次数: 24)

2016-9-11 18:12 上传

点击文件名下载附件

13907933959

413191246se 发表于 2016-9-11 18:13
139：最近经过几天的努力，当然我水平不高，完善不少！现在还有一些疑难数据未攻克（就是佰亿元量级的数据 ...

师傅好！
这个可能看似是一个简单的问题，其实是一个难度很大和相当费脑筋的难题！师傅的转换正确率能到这个程度以经相当的不易了！师傅辛苦了！
师傅、我测试后发现、类似“玖拾亿元零壹分”、“陆拾亿元零柒角”转换后好象还是有不正确的现象。

gbgbxgb

13907933959

gbgbxgb 发表于 2016-9-12 12:33

前辈好！
看到前辈的动画演示，的确可准确转换，可否恳请前辈把代码贴出来分享！在下将感激不尽！

413191246se

顶以更新！（我未解决的金额数据全在《附件---疑难》这个文档中，要解决需要时日。）
139请看1楼更新！（你要处理的数值如果不大于10亿的话，可以应用此宏了！）
如果有哪位高手对此宏感兴趣，不妨在我的基础上继续编程，或全新编程此宏贡献出来造福大家。
谢谢各位！

13907933959

413191246se 发表于 2016-9-12 22:27
顶以更新！（我未解决的金额数据全在《附件---疑难》这个文档中，要解决需要时日。）
139请看1楼更新！（ ...

师傅辛苦了！！！