VFP中将汉字数字转换为阿拉伯数字
VFP中有没有将汉字数字(如二十二)转换为阿拉伯数字(如22)的方法?
[此贴子已经被作者于2019-12-23 14:46编辑过]
Option Explicit Const BiaoChi As String = "十百千万 亿" '本字串中的顺序和中间的空格有讲究 Public Function UsrChnDstr2Digtal(ByVal zf0 As Range, Optional iType As Integer = 0) As Variant '把中文数字字串转换为阿拉伯字串,精确到小数点后四位(后来不限制了),最大不超过千亿. '特点:能自动排除用户输入的其它字符,支持中文大小写阿拉伯数字混输。 '支持字符中以“元”或“点”界定小数点位置 '参数1:一个中文字串(或一个Range对象) '参数2:决定返回字串(默认值)还是返回双精度数值? '代码:王德榜 2019-12-25 Dim zf As String, zfAlone As String, zfXs As String '净化后的字串,取出的单个字串,净化后的小数部分字串 Dim zfZs As String, zf2Xs As String, zf2Out As String '尝试返回的结果:整数部分字串(填充零后),小数部分字串,整数部分字串(输出) Dim iXsd As Integer, ii As Integer, iWw As Integer, iYy As Integer '是否含有小数点/临时变量/万位以上/亿以上 Dim zf3Out As Double '数字结果,整数+小数部分 Dim zfZF As String '正负标志 Dim iLocalW As Integer, iLocalY As Integer '万位/亿位.在标尺中的位置 iLocalW = InStr(1, BiaoChi, "万", vbTextCompare) iLocalY = InStr(1, BiaoChi, "亿", vbTextCompare) '检查用户输入的值是否超过本函数的允许值(小不超过小数后4位,大不超过千亿) If InStr(1, zf0, "兆", vbTextCompare) > 0 Then UsrChnDstr2Digtal = IIf(iType = 0, "数据超范围。", 999999999999#) Exit Function End If zf = zf0 If Left(zf, 1) = "负" Or Left(zf, 1) = "-" Or Left(zf, 1) = "-" Then zfZF = "-" '先判断正负. zf = Mid(zf, 2) End If zf = ProcStr(zf) '先净化字串 '排除用户可能的错误输入:例如一万零零五元,应为一万零五元 While InStr(1, zf, "〇〇", vbTextCompare) > 0 zf = Replace(zf, "〇〇", "〇", 1, -1, vbTextCompare) Wend '检查用户输入的值是否超过本函数的允许值(小不超过小数后4位,大不超过千亿) '原来是小不超过小数点后四位,后来放开这个限制,就不再截断字串了. iXsd = InStr(1, zf, "点", vbTextCompare) '再判断是否含有小数点,若iXsd>0表示含有小数点 If iXsd > 0 Then '如果有小数点,先处理小数部分. zfXs = Mid(zf, iXsd) For ii = 1 To Len(zfXs) zfAlone = Mid(zfXs, ii, 1) zf2Xs = zf2Xs & GetAlone(zfAlone) ' If ii > 1 Then '这是原来想直接获取小数部分数值型值的想法,后来觉得太麻烦不用了. ' zf3Xs = zf3Xs + Val(GetAlone(zfAlone)) * GetWs(LTrim(Str((ii - 1) * -1))) ' End If Next ii zf = Left(zf, iXsd - 1) '处理完小数部分后,小数后部分就不用了. End If '接下来处理整数部分,整数部分必须考虑"〇"占位的问题, '例如"一万〇二"转换为"一〇〇〇二","一千〇二"转换为"一〇〇二","一千"转换为"一〇〇〇" '也就是说,把标志位"千"替换为相应多的"〇" For ii = Len(zf) To 1 Step -1 '考虑到上述问题,整数部分倒循环比较好. zfAlone = Mid(zf, ii, 1) iXsd = InStr(1, BiaoChi, zfAlone, vbTextCompare) '再判断取出的单个字符是否恰是"亿万千百十"中的一个标志位 '由于BiaoChi字串作了精心的安排,此时取出的数位长度与iXsd恰好相关. If iXsd > 0 Then '是标志位字符,则检查填充的〇够不够?够了的话,再去掉标志字符. If iWw = 0 And iYy = 0 Then '万和亿都尚未出现.此时补足到整个字串长度的"〇" If Len(zfZs) < iXsd Then zfZs = String(iXsd - Len(zfZs), "〇") & zfZs ElseIf iWw > 0 And iYy = 0 Then '万已出现,而亿尚未出现.此时补足到"万"的"〇" iWw = InStr(1, zfZs, "万", vbTextCompare) If zfAlone <> "亿" Then If iWw - 1 < iXsd Then zfZs = String(iXsd - iWw + 1, "〇") & zfZs Else '此时看“亿”与“万”之间的“〇”+其它数字够不够?不够补足三个. If iWw - 1 < iLocalY - iLocalW Then zfZs = String(iLocalY - iLocalW - iWw + 1, "〇") & zfZs End If ElseIf iYy > 0 And iWw > 0 Then '万和亿都已出现.此时补足到"亿"的"〇" iYy = InStr(1, zfZs, "亿", vbTextCompare) If iYy - 1 < iXsd Then zfZs = String(iXsd - iYy + 1, "〇") & zfZs ElseIf iYy > 0 And iWw = 0 Then '万未出现,但亿单独出现了(比如"三亿"/"三亿零五百".此时补足到"亿"的"〇" iYy = InStr(1, zfZs, "亿", vbTextCompare) If iYy - 1 < iXsd Then zfZs = String(iXsd - iYy + 1, "〇") & zfZs End If If (zfAlone = "万" And Left(zfZs, 1) <> "万") Then zfZs = zfAlone & zfZs '"万" Or "亿"标志位先保留,方便找出十万/百万/千万/十亿/百亿/千亿 iWw = Len(zfZs) ' InStr(1, zf, "万", vbTextCompare) '找到“万”位置,万是一个重要节点。 End If If (zfAlone = "亿" And Left(zfZs, 1) <> "亿") Then zfZs = zfAlone & zfZs '"万" Or "亿"标志位先保留,方便找出十万/百万/千万/十亿/百亿/千亿 iYy = Len(zfZs) ' InStr(1, zf, "亿", vbTextCompare) '找到“亿”位置,亿是一个重要节点。 End If Else '不是标志位字符,且字符是数字的(不是胡乱输入的),则字符直接相加,此步可以进一步过滤用户的乱输入. '比如用户输入 "二亿一千万欠三百元",中间有"欠"字,既非标志字符,又不是数字字符,则应该在此步过滤掉. If InStr(1, "一,二,三,四,五,六,七,八,九,〇,1,2,3,4,5,6,7,8,9,0", zfAlone, vbTextCompare) Then zfZs = zfAlone & zfZs End If Next ii '整数部分填充零完毕,接下来可直接"翻译"输出了: zfZs = Replace(zfZs, "万", "", 1, -1, vbTextCompare) '但是,在正式"翻译"前, zfZs = Replace(zfZs, "亿", "", 1, -1, vbTextCompare) '须先把"万","亿"还原. For ii = 1 To Len(zfZs) zfAlone = Mid(zfZs, ii, 1) zf2Out = zf2Out & GetAlone(zfAlone) Next ii zf3Out = Val(zfZF & zf2Out & zf2Xs) '返回整数 + 小数部分: If iType = 0 Then ' Debug.Print zf0 & "-->" & zf & zfXs & "==>"; zf2Out & zf2Xs UsrChnDstr2Digtal = zfZF & zf2Out & zf2Xs Else ' Debug.Print zf3Out UsrChnDstr2Digtal = zf3Out End If End Function Function GetWs(ByVal str1) As Double '返回万千百拾等字符对应的位数 --后来觉得直接获取字符型值要简单些,这个Func不用了. '例如参数为“万”则返回数字10000 '如果原始字串含有“点”则证明有小数点后数字,参数为“-1”,则返回数字0.1;参数为“-2”,则返回数字0.01 Select Case str1 Case "-1" GetWs = 0.1 Case "-2" GetWs = 0.01 Case "-3" GetWs = 0.001 Case "-4" GetWs = 0.0001 Case "十" GetWs = 10 Case "百" GetWs = 100 Case "千" GetWs = 1000 Case "万" GetWs = 10000 Case "十万" GetWs = 100000 Case "百万" GetWs = 1000000 Case "千万" GetWs = 10000000 Case "亿" GetWs = 100000000 Case "十亿" GetWs = 1000000000 Case "百亿" GetWs = 10000000000# Case "千亿" GetWs = 100000000000# End Select End Function Function GetAlone(ByVal str1) As String '本模块的任务:返回单个数字, '把“一二三”等字符转换为“123”等对应的数字字符 Dim dx1 As String, dx2 As String, strTmp Dim arrDx1() As String, arrDx2() As String Dim ii As Integer strTmp = str1 dx2 = "1,2,3,4,5,6,7,8,9,0,." dx1 = "一,二,三,四,五,六,七,八,九,〇,点" arrDx1 = Split(dx1, ",") arrDx2 = Split(dx2, ",") 'Debug.Print UBound(arrDx1) For ii = 0 To UBound(arrDx1) If InStr(1, strTmp, arrDx1(ii), vbTextCompare) > 0 Then strTmp = Replace(strTmp, arrDx1(ii), arrDx2(ii), 1, -1, vbTextCompare) End If Next ii GetAlone = strTmp End Function Function ProcStr(ByVal str1) As String '净化原始字串,本模块的任务有: '统一“节点标志”,比如,把“仟”换为“千”;佰->百;拾->十;元->点;角、分->无 '再把大写的“壹贰叁”等转换为“一二三” '若字符串的首字符为“拾”或“十”,则首字符换为“一” '若字符串的首字符为除“拾”之外的“百/千/万/亿”等“标志位”,则去掉首字符。 '若字符串的末字符为“点”,则去掉末字符。 Dim dx1 As String, dx2 As String, strTmp Dim arrDx1() As String, arrDx2() As String Dim ii As Integer strTmp = str1 dx1 = "壹,贰,叁,肆,伍,陆,柒,捌,玖,零,仟,拾,佰,元,角,分,正,整" dx2 = "一,二,三,四,五,六,七,八,九,〇,千,十,百,点,,,," arrDx1 = Split(dx1, ",") arrDx2 = Split(dx2, ",") 'Debug.Print UBound(arrDx1) For ii = 0 To UBound(arrDx1) If InStr(1, strTmp, arrDx1(ii), vbTextCompare) > 0 Then strTmp = Replace(strTmp, arrDx1(ii), arrDx2(ii), 1, -1, vbTextCompare) End If Next ii If Left(strTmp, 1) = "十" Then strTmp = "一" & strTmp '若字符串的首字符为“拾”或“十”,则首字符换为“一” '若字符串的首字符为除“拾”之外的“百/千/万/亿”等“标志位”,则去掉首字符。 If InStr(1, "百/千/万/亿", Left(strTmp, 1), vbTextCompare) > 0 Then strTmp = Mid(strTmp, 2) If Right(strTmp, 1) = "点" Then strTmp = Left(strTmp, Len(strTmp) - 1) '若字符串的末字符为“点”,则去掉末字符。 ProcStr = strTmp End Function