中文大小写数字转阿拉伯数字

mzbao

前两天看到一个关于“中文大小写数字转阿拉伯数字”的分享贴，发现提供的代码只能转整数，我后面在论坛里搜了一下这方面的帖子，也没有发现特别完善的代码。要不只能转换整数，要不就是只能转换大写人民币。

所以我这两天再考虑能不能把中文大小写数字和大写人民币数字转换阿拉伯数字整合到一个函数里，下面就是这两天的研究成果。我测试了一下，应该算是相对完善了。此函数可以转中文大小写数字（整数和小数都可以）和大写人民币。中文数字的写法接受一定的容错，如果离常规写法实在差太远就没办法了。

mzbao

下面是代码；

1. Public Function CNToNum(sDBNum)
   
2. '=============================
   
3. '中文大小写转阿拉伯数字函数
   
4. '中文大写人民币数字转阿拉伯数字
   
5. 'by mzbao
   
6. '=============================
   
7.     Dim sCNnum$, sCNExp$, ExpArr, temp, i%, sChar$, NumChar$
   
8.     Dim m%, n%, rNum%, d%
   
9.     Dim LastExp%, Exp%, sFlag$, HasExp As Boolean
   
10. 
    
11.     sCNnum = "〇零一二三四五六七八九壹贰叁肆伍陆柒捌玖00123456789123456789"
    
12.     sCNExp = ",十,百,千,万,亿,兆,拾,佰,仟,萬,1,2,3,4,8,12,1,2,3,4"
    
13.     ExpArr = Split(sCNExp, ",")
    
14.    
    
15.     For i = 1 To 3
    
16.         sDBNum = Replace(sDBNum, Mid("整角分", i, 1), "")
    
17.         sDBNum = Replace(sDBNum, Mid("点元圆", i, 1), ".")
    
18.         sDBNum = Replace(sDBNum, Mid("○", i, 1), "零")
    
19.     Next i
    
20.    
    
21.     sDBTxt = sDBNum
    
22.     For i = Len(sDBTxt) To 1 Step -1
    
23.         sChar = Mid(sDBTxt, i, 1)
    
24.         m = InStr(sCNnum, sChar)
    
25.         If m > 0 Then
    
26.             If rNum = 0 Then rNum = i
    
27.             If m <= 20 Then
    
28.                 NumChar = Mid(sCNnum, m + 20, 1)
    
29.             Else
    
30.                 NumChar = sChar
    
31.             End If
    
32.             If HasExp = False Then
    
33.                 temp = NumChar & temp
    
34.             Else
    
35.                 temp = NumChar & Mid(temp, 2)
    
36.                 If NumChar = 0 Then temp = 1 & Mid(temp, 2)
    
37.             End If
    
38.             HasExp = False
    
39.             If Exp > LastExp Then LastExp = 0
    
40.         Else
    
41.             n = InStr(sCNExp, sChar)
    
42.             If n > 0 Then
    
43.                 Exp = ExpArr(n / 2 + 10)
    
44.                 If InStr(",4,8,12,", "," & Exp & ",") Then
    
45.                     If LastExp >= Exp Then
    
46.                         LastExp = LastExp + Exp: Exp = 0
    
47.                     Else
    
48.                         LastExp = Exp: Exp = 0
    
49.                     End If
    
50.                 End If
    
51.                 sFlag = String(Exp + LastExp + 1 + d, "0")
    
52.                 temp = Format(1 * temp, sFlag)
    
53.                 HasExp = True
    
54.             End If
    
55.             If sChar = "." Then
    
56.                 If i < rNum Then d = rNum - i
    
57.             End If
    
58.         End If
    
59.     Next
    
60.     If Left(temp, 1) = "0" And Len(temp) > 1 And Len(temp) > d + 1 Then temp = 1 & Mid(temp, 2)
    
61. 
    
62.     CNToNum = 1 * temp / 10 ^ d
    
63. End Function

复制代码

719404338

学习了，记号。

vvw123

很不错做个记号

vvw123

1. Private Function toNum(myStr)
   
2. '==========================================================
   
3. '中文小写转阿拉伯数字函数
   
4. 'Writen by 时光鸟
   
5. '2012-12-24 于 武汉
   
6. 
   
7. 'ver 2.0 beta (update 2013-6-17)
   
8. '*改进数量级左侧为非转化文本时的转化Bug(感谢excelhome论坛"星语心愿"朋友的反馈)
   
9. 'ver 1.9 beta (update 2013-1-12)
   
10. '*改进极个别情况最右侧数量级的右侧为非转化文本时的转化Bug
    
11. 'ver 1.8 beta (update 2012-12-30)
    
12. '*改进少数情况下把"二"习惯用成"两"的时候的转化问题
    
13. '*改进极个别情况下"〇"或"零"后直接跟数量级时的转化问题
    
14. '*对小部分中文小写数字的不规范表达增加纠错转化功能
    
15. '*增加对中文小写乘法口诀转化的功能支持
    
16. 'ver 1.7 beta (update 2012-12-29)
    
17. '*改进个别情况下需要在中文小写中同时使用〇和零时的转化问题
    
18. '*优化代码结构，提升效率
    
19. 'ver 1.6 beta (updat'e 2012-12-28)
    
20. '*解决了首位只有数量级时这种简化表达方式转化不正确的Bug
    
21. 'ver 1.5 beta (update 2012-12-27)
    
22. '*解决了〇右侧有多个数量级时某种情况替换数量不正确的Bug
    
23. 'ver 1.4 beta (update 2012-12-27)
    
24. '*解决了〇右侧有多个数量级时替换数量不正确的Bug
    
25. 'ver 1.3 beta (update 2012-12-26)
    
26. '*解决了连续有多个数量级时转化不正确的Bug
    
27. 'ver 1.2 beta (update 2012-12-26)
    
28. '*解决了中文小写中某种情况下使用汉字“零”时转化不正确的Bug
    
29. 'ver 1.1 beta (update 2012-12-25)
    
30. '*解决了中文小写中含有〇的情况下时转化不正确的Bug
    
31. 'ver 1.0 beta (update 2012-12-24)
    
32. '*中文小写转阿拉伯数字正常表达方式转化函数发布
    
33. '==========================================================
    
34. 
    
35. Dim strG$, strL$, strN$, strZ$, findZ$, addZ$
    
36. Dim i%, m%, n%, k%, Lv%, Rv%, Lx%, Rx%, R1%, R2%, Ly%, Ry%, Tx%, flagP%
    
37. strG = "十百千万亿"
    
38. strL = "一二三四五六七八九"
    
39. strN = "123456789"
    
40. strZ = "〇零"
    
41. If myStr = "" Then Exit Function
    
42. While (InStr(myStr, Left(strZ, 1)) + InStr(myStr, Right(strZ, 1)) > 0)
    
43.     Lv = InStr(myStr, Left(strZ, 1))
    
44.     Rv = InStr(myStr, Right(strZ, 1))
    
45.     If Lv > 0 Then If Rv = 0 Or Rv > Lv Then findZ = Left(strZ, 1)
    
46.     If Rv > 0 Then If Lv = 0 Or Lv > Rv Then findZ = Right(strZ, 1)
    
47.     m = InStr(myStr, findZ)
    
48.     If m < Len(myStr) And InStr(strG, Mid(myStr, m + 1, 1)) Then
    
49.        myStr = Left(myStr, m) & "一" & Mid(myStr, m + 1)
    
50.     End If
    
51.     If Mid(myStr, m - 1, 1) <> "" Then Lx = InStr(strG, Mid(myStr, m - 1, 1)) Else Lx = 0
    
52.     If Mid(myStr, m + 2, 1) <> "" Then R1 = InStr(strG, Mid(myStr, m + 2, 1)) Else R1 = 0
    
53.     If Mid(myStr, m + 3, 1) <> "" Then R2 = InStr(strG, Mid(myStr, m + 3, 1)) Else R2 = 0
    
54.     If R2 = 5 Then Rx = R1 + R2 + 3 Else Rx = R1 + R2
    
55.     If Lx > 0 And Lx < R1 Then Rx = 0
    
56.     If Lx > R1 And Lx < R2 Then Rx = R1
    
57.     If Lx = 5 Then Lx = Lx + 3
    
58.     If Lx = 0 And Rx = 0 Then Lx = 2
    
59.     myStr = Replace(myStr, findZ, Mid(10 ^ (Lx - Rx - 1), 2), 1, 1)
    
60. Wend
    
61. Do
    
62.   If Len(myStr) < 2 Then Exit Do
    
63.   If Mid(myStr, n + 1, 1) <> "" Then Ly = InStr(strG, Mid(myStr, n + 1, 1)) Else Ly = 0
    
64.   If Mid(myStr, n + 2, 1) <> "" Then Ry = InStr(strG, Mid(myStr, n + 2, 1)) Else Ry = 0
    
65.   If Ly > 0 And Ry > 0 Then
    
66.      If Ly = 5 Then addZ = Mid(10 ^ (Ly + 3), 2) Else addZ = Mid(10 ^ Ly, 2)
    
67.      myStr = Left(myStr, n + 1) & addZ & Mid(myStr, n + 2)
    
68.      n = n + Len(addZ)
    
69.   Else
    
70.      n = n + 1
    
71.   End If
    
72. Loop Until (n = Len(myStr) - 1)
    
73. If Len(myStr) > 3 And InStr(strL, Left(myStr, 1)) * InStr(strL, Mid(myStr, 2, 1)) Then
    
74.    If Len(myStr) = 4 And Mid(myStr, 3, 1) = "得" Then myStr = Left(myStr, 1) & "×" & Replace(Mid(myStr, 2), "得", "=")
    
75.    If Len(myStr) < 6 And InStr(strL, Mid(myStr, 3, 1)) > 0 And InStr(strG, Mid(myStr, 4, 1)) > 0 Then
    
76.       myStr = Left(myStr, 1) & "×" & Mid(myStr, 2, 1) & "=" & Mid(myStr, 3)
    
77.    End If
    
78. End If
    
79. If InStr(myStr, "两") > 0 Then myStr = Replace(myStr, "两", "二")
    
80. 
    
81. If InStr(strG, Left(myStr, 1)) > 0 Then myStr = "一" & myStr
    
82. While (flagP <= Len(myStr) - 2)
    
83.   flagP = flagP + 1
    
84.   If InStr(strG, Mid(myStr, flagP + 1, 1)) > 0 And InStr(strG & strL & strZ & strN & "1234567890", Mid(myStr, flagP, 1)) = 0 Then
    
85.      myStr = Left(myStr, flagP) & "一" & Mid(myStr, flagP + 1)
    
86.   End If
    
87. Wend
    
88. 
    
89. If Len(myStr) > 1 Then
    
90.    For i = Len(myStr) - 1 To 1 Step -1
    
91.       k = InStr(strG, Right(myStr, 1))
    
92.       If k = 5 Then myStr = myStr & Mid(10 ^ (k + 3), 2) Else If k > 0 Then myStr = myStr & Mid(10 ^ k, 2)
    
93.       If k = 0 Then
    
94.          Tx = InStr(strG, Mid(myStr, i, 1))
    
95.          If Tx > 0 And InStr(strL, Mid(myStr, i + 1, 1)) = 0 And Mid(myStr, i + 1, 1) <> "0" Then
    
96.             If Tx = 5 Then addZ = Mid(10 ^ (Tx + 3), 2) Else addZ = Mid(10 ^ Tx, 2)
    
97.             myStr = Left(myStr, i) & addZ & Mid(myStr, i + 1)
    
98.          End If
    
99.      End If
    
100.    Next i
     
101. End If
     
102. For i = 1 To Len(strL)
     
103.    If i <= Len(strG) And InStr(myStr, Mid(strG, i, 1)) Then myStr = Replace(myStr, Mid(strG, i, 1), "")
     
104.    If InStr(myStr, Mid(strL, i, 1)) > 0 Then myStr = Replace(myStr, Mid(strL, i, 1), Mid(strN, i, 1))
     
105. Next i
     
106. toNum = myStr
     
107. End Function

复制代码

Excel [原创]中文小写转阿拉伯数字自定义函数-ExcelVBA程序开发-ExcelHome技术论坛 -  http://club.excelhome.net/thread-974120-1-1.html
时光鸟的作品

陈功

收藏学习中

mzbao

vvw123 发表于 2019-3-30 19:41
Excel [原创]中文小写转阿拉伯数字自定义函数-ExcelVBA程序开发-ExcelHome技术论坛 -  http://club.excel ...

我就是看到你提的这个帖子，这个代码局限性太大，不能识别大写数字，不能识别大写人民币，也没法识别小数位。才让我萌生自己写一个的想法。

vvw123

mzbao 发表于 2019-3-31 00:17
我就是看到你提的这个帖子，这个代码局限性太大，不能识别大写数字，不能识别大写人民币，也没法识别小数 ...

昨天我也试了，确实如你所说所说，有局限性，例如小数就不能解决。感谢提供代码分享。

mzbao

以下代码比前面再稍微简化了一下，总体上一样的。

1. Public Function CNToNum(sDBNum)
   
2. '=============================
   
3. '中文大小写转阿拉伯数字函数
   
4. '中文大写人民币数字转阿拉伯数字
   
5. 'by mzbao
   
6. '=============================
   
7.     Dim temp, i%, sChar$, rNum%, d%
   
8.     Dim LastExp%, Exp%, sFlag$, HasExp As Boolean
   
9.    
   
10.     For i = 1 To 3
    
11.         sDBNum = Replace(sDBNum, Mid("整角分", i, 1), "")
    
12.         sDBNum = Replace(sDBNum, Mid("点元圆", i, 1), ".")
    
13.         sDBNum = Replace(sDBNum, Mid("○", i, 1), "零")
    
14.     Next i
    
15.    
    
16.     For i = 0 To 9
    
17.         sDBNum = Replace(sDBNum, Mid("〇一二三四五六七八九", i + 1, 1), i)
    
18.         sDBNum = Replace(sDBNum, Mid("零壹贰叁肆伍陆柒捌玖", i + 1, 1), i)
    
19.     Next
    
20.    
    
21.     sDBTxt = sDBNum
    
22.     For i = Len(sDBTxt) To 1 Step -1
    
23.         sChar = Mid(sDBTxt, i, 1)
    
24.         If IsNumeric(sChar) Then
    
25.             If rNum = 0 Then rNum = i
    
26.             If HasExp = False Then
    
27.                 temp = sChar & temp
    
28.             Else
    
29.                 temp = sChar & Mid(temp, 2)
    
30.                 If sChar = 0 Then temp = 1 & Mid(temp, 2)
    
31.             End If
    
32.             HasExp = False
    
33.             If Exp > LastExp Then LastExp = 0
    
34.         Else
    
35.             Exp = InStr("十百千万十百千亿十百千兆", sChar)
    
36.             If Exp = 0 Then Exp = InStr("拾佰仟萬", sChar)
    
37.             If Exp > 0 Then
    
38.                  If InStr(",4,8,12,", "," & Exp & ",") Then
    
39.                     If LastExp >= Exp Then
    
40.                         LastExp = LastExp + Exp: Exp = 0
    
41.                     Else
    
42.                         LastExp = Exp: Exp = 0
    
43.                     End If
    
44.                 End If
    
45.                 sFlag = String(Exp + LastExp + 1 + d, "0")
    
46.                 temp = Format(1 * temp, sFlag)
    
47.                 HasExp = True
    
48.             End If
    
49.             If sChar = "." Then
    
50.                 If i < rNum Then d = rNum - i
    
51.             End If
    
52.         End If
    
53.     Next
    
54.     If Left(temp, 1) = "0" And Len(temp) > 1 And Len(temp) > d + 1 Then temp = 1 & Mid(temp, 2)
    
55. 
    
56.     CNToNum = 1 * temp / 10 ^ d
    
57. End Function

复制代码

ljpmqb888

学习了！！经典之作！！