大小写数字转换问题

yjwdjfqb

大小写数字转换问题

大小写转换.rar (8.57 KB, 下载次数: 7)

2019-12-8 00:36 上传

点击文件名下载附件

那个老师有这样的代码分享一个，或高手老师们帮弄一个，谢谢老师们了!
万分感谢大家了!

蓝桥玄霜

中文转阿拉伯数字的代码不多，找到一个。

1. Function zwsz(ByVal Rng)
   
2. On Error Resume Next
   
3. Dim Arr, Arr2, Dic
   
4. Dim Str As String
   
5. Dim M, N, I As Long
   
6. Dim y1, y2, II, Q%
   
7. Dim yy As Boolean
   
8. 
   
9. Set Dic = CreateObject("scripting.dictionary")  '创建字典用于存储转换值
   
10. Dic.Add "亿", "*100000000+"
    
11. Dic.Add "千", "*1000+"
    
12. Dic.Add "仟", "*1000+"
    
13. Dic.Add "百", "*100+"
    
14. Dic.Add "佰", "*100+"
    
15. Dic.Add "十", "*10+"
    
16. Dic.Add "拾", "*10+"
    
17. Dic.Add "九", "9"
    
18. Dic.Add "玖", "9"
    
19. Dic.Add "八", "8"
    
20. Dic.Add "捌", "8"
    
21. Dic.Add "七", "7"
    
22. Dic.Add "柒", "7"
    
23. Dic.Add "六", "6"
    
24. Dic.Add "陆", "6"
    
25. Dic.Add "五", "5"
    
26. Dic.Add "伍", "5"
    
27. Dic.Add "四", "4"
    
28. Dic.Add "肆", "4"
    
29. Dic.Add "三", "3"
    
30. Dic.Add "叁", "3"
    
31. Dic.Add "二", "2"
    
32. Dic.Add "贰", "2"
    
33. Dic.Add "一", "1"
    
34. Dic.Add "壹", "1"
    
35. Arr = Dic.keys  '将字典的keys赋值给数组，便于取用
    
36. If Rng <> "" Then
    
37.     Str = Rng
    
38. If InStr(Str, "亿") > 0 Then   '将亿替换成分隔符便于分开计算
    
39.     y1 = Split(Str, "亿")(0)
    
40.     y2 = Split(Str, "亿")(1)
    
41.     yy = True
    
42.     GoTo 0
    
43. Else
    
44. 0:
    
45.     If yy = True Then Str = y1
    
46. 1:
    
47.     Q = Q + 1
    
48.     Str = Replace(Str, "万", vbTab)    '将万替换成分隔符便于分开计算
    
49.     For M = LBound(Arr) To UBound(Arr)  '循环替换对应的大写数字为对应阿拉伯数字
    
50.         Str = Replace(Str, Arr(M), Dic(Arr(M)))
    
51.     Next M
    
52.    
    
53.     Str = Replace(Str, "零", "")   '替换掉多余的字符
    
54.     Str = Replace(Str, "+*", "*")
    
55.     Arr2 = Split(Str, vbTab)   '拆分字符串为数组，方便各数量级的数字累加
    
56.    
    
57.     I = 0
    
58.     For M = LBound(Arr2) To UBound(Arr2)
    
59.         If Right(Arr2(M), 1) = "+" Then Arr2(M) = Left(Arr2(M), Len(Arr2(M)) - 1)  '替换两种可能存在的情况
    
60.         If Left(Arr2(M), 1) = "*" Then Arr2(M) = Right(Arr2(M), Len(Arr2(M)) - 1)
    
61.         If Arr2(M) = "" Then
    
62.             If M < UBound(Arr2) Then I = I + 10000 ^ (UBound(Arr2) - M)
    
63.         Else
    
64.             If InStr(Arr2(M), "*") > 0 Or InStr(Arr2(M), "+") > 0 Then
    
65.                 I = I + Evaluate(Arr2(M)) * 10000 ^ (UBound(Arr2) - M)
    
66.             Else
    
67.                 I = I + Arr2(M) * 10000 ^ (UBound(Arr2) - M)
    
68.             End If
    
69.         End If
    
70.     Next M
    
71.    
    
72.     If Q = 1 And yy = True Then
    
73.        Str = y2
    
74.        II = I
    
75.        GoTo 1
    
76.     ElseIf Q = 2 Then
    
77.        II = II * 100000000 + I
    
78.        If y2 <> "" And I = 0 Then
    
79.          zwsz = 0 '返回结果
    
80.        Else
    
81.          zwsz = II '返回结果
    
82.        End If
    
83.        Exit Function
    
84.     End If
    
85. End If
    
86.     zwsz = I   '返回结果
    
87. End If
    
88. Application.Volatile  '设置为易失性函数，可以即时更新
    
89. Set Dic = Nothing  '清空项目
    
90. End Function
    

复制代码