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

mzbao · 发表于 2019-3-29 23:05

本帖最后由 mzbao 于 2019-3-31 10:36 编辑

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

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

mzbao · 发表于 2019-3-29 23:05

本帖最后由 mzbao 于 2019-3-29 23:12 编辑

下面是代码；

Public Function CNToNum(sDBNum)
'=============================
'中文大小写转阿拉伯数字函数
'中文大写人民币数字转阿拉伯数字
'by mzbao
'=============================
Dim sCNnum$, sCNExp$, ExpArr, temp, i%, sChar$, NumChar$
Dim m%, n%, rNum%, d%
Dim LastExp%, Exp%, sFlag$, HasExp As Boolean
sCNnum = "〇零一二三四五六七八九壹贰叁肆伍陆柒捌玖00123456789123456789"
sCNExp = ",十,百,千,万,亿,兆,拾,佰,仟,萬,1,2,3,4,8,12,1,2,3,4"
ExpArr = Split(sCNExp, ",")
For i = 1 To 3
sDBNum = Replace(sDBNum, Mid("整角分", i, 1), "")
sDBNum = Replace(sDBNum, Mid("点元圆", i, 1), ".")
sDBNum = Replace(sDBNum, Mid("○", i, 1), "零")
Next i
sDBTxt = sDBNum
For i = Len(sDBTxt) To 1 Step -1
sChar = Mid(sDBTxt, i, 1)
m = InStr(sCNnum, sChar)
If m > 0 Then
If rNum = 0 Then rNum = i
If m <= 20 Then
NumChar = Mid(sCNnum, m + 20, 1)
Else
NumChar = sChar
End If
If HasExp = False Then
temp = NumChar & temp
Else
temp = NumChar & Mid(temp, 2)
If NumChar = 0 Then temp = 1 & Mid(temp, 2)
End If
HasExp = False
If Exp > LastExp Then LastExp = 0
Else
n = InStr(sCNExp, sChar)
If n > 0 Then
Exp = ExpArr(n / 2 + 10)
If InStr(",4,8,12,", "," & Exp & ",") Then
If LastExp >= Exp Then
LastExp = LastExp + Exp: Exp = 0
Else
LastExp = Exp: Exp = 0
End If
End If
sFlag = String(Exp + LastExp + 1 + d, "0")
temp = Format(1 * temp, sFlag)
HasExp = True
End If
If sChar = "." Then
If i < rNum Then d = rNum - i
End If
End If
Next
If Left(temp, 1) = "0" And Len(temp) > 1 And Len(temp) > d + 1 Then temp = 1 & Mid(temp, 2)
CNToNum = 1 * temp / 10 ^ d
End Function

复制代码

719404338 · 发表于 2019-3-30 18:06

学习了，记号。

vvw123 · 发表于 2019-3-30 18:37

很不错做个记号

vvw123 · 发表于 2019-3-30 19:41

Private Function toNum(myStr)
'==========================================================
'中文小写转阿拉伯数字函数
'Writen by 时光鸟
'2012-12-24 于武汉
'ver 2.0 beta (update 2013-6-17)
'*改进数量级左侧为非转化文本时的转化Bug(感谢excelhome论坛"星语心愿"朋友的反馈)
'ver 1.9 beta (update 2013-1-12)
'*改进极个别情况最右侧数量级的右侧为非转化文本时的转化Bug
'ver 1.8 beta (update 2012-12-30)
'*改进少数情况下把"二"习惯用成"两"的时候的转化问题
'*改进极个别情况下"〇"或"零"后直接跟数量级时的转化问题
'*对小部分中文小写数字的不规范表达增加纠错转化功能
'*增加对中文小写乘法口诀转化的功能支持
'ver 1.7 beta (update 2012-12-29)
'*改进个别情况下需要在中文小写中同时使用〇和零时的转化问题
'*优化代码结构，提升效率
'ver 1.6 beta (updat'e 2012-12-28)
'*解决了首位只有数量级时这种简化表达方式转化不正确的Bug
'ver 1.5 beta (update 2012-12-27)
'*解决了〇右侧有多个数量级时某种情况替换数量不正确的Bug
'ver 1.4 beta (update 2012-12-27)
'*解决了〇右侧有多个数量级时替换数量不正确的Bug
'ver 1.3 beta (update 2012-12-26)
'*解决了连续有多个数量级时转化不正确的Bug
'ver 1.2 beta (update 2012-12-26)
'*解决了中文小写中某种情况下使用汉字“零”时转化不正确的Bug
'ver 1.1 beta (update 2012-12-25)
'*解决了中文小写中含有〇的情况下时转化不正确的Bug
'ver 1.0 beta (update 2012-12-24)
'*中文小写转阿拉伯数字正常表达方式转化函数发布
'==========================================================
Dim strG$, strL$, strN$, strZ$, findZ$, addZ$
Dim i%, m%, n%, k%, Lv%, Rv%, Lx%, Rx%, R1%, R2%, Ly%, Ry%, Tx%, flagP%
strG = "十百千万亿"
strL = "一二三四五六七八九"
strN = "123456789"
strZ = "〇零"
If myStr = "" Then Exit Function
While (InStr(myStr, Left(strZ, 1)) + InStr(myStr, Right(strZ, 1)) > 0)
Lv = InStr(myStr, Left(strZ, 1))
Rv = InStr(myStr, Right(strZ, 1))
If Lv > 0 Then If Rv = 0 Or Rv > Lv Then findZ = Left(strZ, 1)
If Rv > 0 Then If Lv = 0 Or Lv > Rv Then findZ = Right(strZ, 1)
m = InStr(myStr, findZ)
If m < Len(myStr) And InStr(strG, Mid(myStr, m + 1, 1)) Then
myStr = Left(myStr, m) & "一" & Mid(myStr, m + 1)
End If
If Mid(myStr, m - 1, 1) <> "" Then Lx = InStr(strG, Mid(myStr, m - 1, 1)) Else Lx = 0
If Mid(myStr, m + 2, 1) <> "" Then R1 = InStr(strG, Mid(myStr, m + 2, 1)) Else R1 = 0
If Mid(myStr, m + 3, 1) <> "" Then R2 = InStr(strG, Mid(myStr, m + 3, 1)) Else R2 = 0
If R2 = 5 Then Rx = R1 + R2 + 3 Else Rx = R1 + R2
If Lx > 0 And Lx < R1 Then Rx = 0
If Lx > R1 And Lx < R2 Then Rx = R1
If Lx = 5 Then Lx = Lx + 3
If Lx = 0 And Rx = 0 Then Lx = 2
myStr = Replace(myStr, findZ, Mid(10 ^ (Lx - Rx - 1), 2), 1, 1)
Wend
Do
If Len(myStr) < 2 Then Exit Do
If Mid(myStr, n + 1, 1) <> "" Then Ly = InStr(strG, Mid(myStr, n + 1, 1)) Else Ly = 0
If Mid(myStr, n + 2, 1) <> "" Then Ry = InStr(strG, Mid(myStr, n + 2, 1)) Else Ry = 0
If Ly > 0 And Ry > 0 Then
If Ly = 5 Then addZ = Mid(10 ^ (Ly + 3), 2) Else addZ = Mid(10 ^ Ly, 2)
myStr = Left(myStr, n + 1) & addZ & Mid(myStr, n + 2)
n = n + Len(addZ)
Else
n = n + 1
End If
Loop Until (n = Len(myStr) - 1)
If Len(myStr) > 3 And InStr(strL, Left(myStr, 1)) * InStr(strL, Mid(myStr, 2, 1)) Then
If Len(myStr) = 4 And Mid(myStr, 3, 1) = "得" Then myStr = Left(myStr, 1) & "×" & Replace(Mid(myStr, 2), "得", "=")
If Len(myStr) < 6 And InStr(strL, Mid(myStr, 3, 1)) > 0 And InStr(strG, Mid(myStr, 4, 1)) > 0 Then
myStr = Left(myStr, 1) & "×" & Mid(myStr, 2, 1) & "=" & Mid(myStr, 3)
End If
End If
If InStr(myStr, "两") > 0 Then myStr = Replace(myStr, "两", "二")
If InStr(strG, Left(myStr, 1)) > 0 Then myStr = "一" & myStr
While (flagP <= Len(myStr) - 2)
flagP = flagP + 1
If InStr(strG, Mid(myStr, flagP + 1, 1)) > 0 And InStr(strG & strL & strZ & strN & "1234567890", Mid(myStr, flagP, 1)) = 0 Then
myStr = Left(myStr, flagP) & "一" & Mid(myStr, flagP + 1)
End If
Wend
If Len(myStr) > 1 Then
For i = Len(myStr) - 1 To 1 Step -1
k = InStr(strG, Right(myStr, 1))
If k = 5 Then myStr = myStr & Mid(10 ^ (k + 3), 2) Else If k > 0 Then myStr = myStr & Mid(10 ^ k, 2)
If k = 0 Then
Tx = InStr(strG, Mid(myStr, i, 1))
If Tx > 0 And InStr(strL, Mid(myStr, i + 1, 1)) = 0 And Mid(myStr, i + 1, 1) <> "0" Then
If Tx = 5 Then addZ = Mid(10 ^ (Tx + 3), 2) Else addZ = Mid(10 ^ Tx, 2)
myStr = Left(myStr, i) & addZ & Mid(myStr, i + 1)
End If
End If
Next i
End If
For i = 1 To Len(strL)
If i <= Len(strG) And InStr(myStr, Mid(strG, i, 1)) Then myStr = Replace(myStr, Mid(strG, i, 1), "")
If InStr(myStr, Mid(strL, i, 1)) > 0 Then myStr = Replace(myStr, Mid(strL, i, 1), Mid(strN, i, 1))
Next i
toNum = myStr
End Function

复制代码

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

陈功 · 发表于 2019-3-30 20:24

收藏学习中

mzbao · 发表于 2019-3-31 00:17

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

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

vvw123 · 发表于 2019-3-31 08:23

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

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

mzbao · 发表于 2019-3-31 11:26

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

Public Function CNToNum(sDBNum)
'=============================
'中文大小写转阿拉伯数字函数
'中文大写人民币数字转阿拉伯数字
'by mzbao
'=============================
Dim temp, i%, sChar$, rNum%, d%
Dim LastExp%, Exp%, sFlag$, HasExp As Boolean
For i = 1 To 3
sDBNum = Replace(sDBNum, Mid("整角分", i, 1), "")
sDBNum = Replace(sDBNum, Mid("点元圆", i, 1), ".")
sDBNum = Replace(sDBNum, Mid("○", i, 1), "零")
Next i
For i = 0 To 9
sDBNum = Replace(sDBNum, Mid("〇一二三四五六七八九", i + 1, 1), i)
sDBNum = Replace(sDBNum, Mid("零壹贰叁肆伍陆柒捌玖", i + 1, 1), i)
Next
sDBTxt = sDBNum
For i = Len(sDBTxt) To 1 Step -1
sChar = Mid(sDBTxt, i, 1)
If IsNumeric(sChar) Then
If rNum = 0 Then rNum = i
If HasExp = False Then
temp = sChar & temp
Else
temp = sChar & Mid(temp, 2)
If sChar = 0 Then temp = 1 & Mid(temp, 2)
End If
HasExp = False
If Exp > LastExp Then LastExp = 0
Else
Exp = InStr("十百千万十百千亿十百千兆", sChar)
If Exp = 0 Then Exp = InStr("拾佰仟萬", sChar)
If Exp > 0 Then
If InStr(",4,8,12,", "," & Exp & ",") Then
If LastExp >= Exp Then
LastExp = LastExp + Exp: Exp = 0
Else
LastExp = Exp: Exp = 0
End If
End If
sFlag = String(Exp + LastExp + 1 + d, "0")
temp = Format(1 * temp, sFlag)
HasExp = True
End If
If sChar = "." Then
If i < rNum Then d = rNum - i
End If
End If
Next
If Left(temp, 1) = "0" And Len(temp) > 1 And Len(temp) > d + 1 Then temp = 1 & Mid(temp, 2)
CNToNum = 1 * temp / 10 ^ d
End Function

复制代码

ljpmqb888 · 发表于 2019-4-4 07:53

学习了！！经典之作！！

		自动登录	找回密码
密码			免费注册

[分享] 中文大小写数字转阿拉伯数字

评分

评分

评分

评分