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

老球球

mzbao 发表于 2019-3-31 11:26
以下代码比前面再稍微简化了一下，总体上一样的。

如何能够支持二百五，三万二这些转换？
二百五转换后205，三万二转换后30002，正确值为：250，32000

mzbao

老球球 发表于 2022-6-14 08:21
如何能够支持二百五，三万二这些转换？
二百五转换后205，三万二转换后30002，正确值为：250，32000

重新换了个思路编写了代码，你试试这个。

1. Public Function CNToNum(sDBNum)
   
2. '=============================
   
3. '中文大小写转阿拉伯数字函数
   
4. '中文大写人民币数字转阿拉伯数字
   
5. 'by mzbao
   
6. '=============================
   
7.     Dim i%, k%, p%, sChar$, lastChar$, Exp%
   
8.     Dim figureArr(1 To 15), expArr(1 To 15), s
   
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.     If Len(sDBNum) = 0 Then s = 0: GoTo EndCal
    
22.    
    
23.     If Not IsNumeric(Left(sDBNum, 1)) Then
    
24.         sDBNum = "1" & sDBNum
    
25.     End If
    
26.    
    
27.     For i = 1 To Len(sDBNum)
    
28.         sChar = Mid(sDBNum, i, 1)
    
29.         If IsNumeric(sChar & "0") Then
    
30.             If i > 1 And IsNumeric(lastChar & "0") Then
    
31.                 figureArr(k) = figureArr(k) & sChar
    
32.             Else
    
33.                 k = k + 1
    
34.                 figureArr(k) = sChar
    
35.             End If
    
36.         Else
    
37.             Exp = InStr("十百千万十百千亿十百千兆", sChar)
    
38.             If Exp = 0 Then Exp = InStr("拾佰仟萬", sChar)
    
39.             expArr(k) = expArr(k) + Exp
    
40.         End If
    
41.         lastChar = sChar
    
42.     Next
    
43.    
    
44.     '指数调整
    
45.     For i = k To 1 Step -1
    
46.         If expArr(i) > p Then p = Int(expArr(i) / 4) * 4
    
47.         If expArr(i) < p Then expArr(i) = expArr(i) + p
    
48.     Next
    
49.    
    
50.     If k > 1 Then '调整尾数的指数
    
51.         If expArr(k) = 0 And expArr(k - 1) > 1 Then
    
52.             If Left(figureArr(k), 1) > 0 Then
    
53.                 expArr(k) = expArr(k - 1) - 1
    
54.             End If
    
55.         End If
    
56.     End If
    
57.    
    
58.     For i = 1 To k
    
59.         If expArr(i) > 0 And figureArr(i) = 0 Then figureArr(i) = 1
    
60.         s = s + figureArr(i) * 10 ^ expArr(i)
    
61.     Next
    
62.    
    
63.     s = Val(s)
    
64. EndCal:
    
65.     CNToNum = s
    
66. End Function

复制代码

天狼骑士2013

感谢创造性设计

blackttea1

收藏好贴，可以用