VFP中将汉字数字转换为阿拉伯数字 - 编程论坛

#2

sdta2019-12-22 17:08

上传需要转换的数据看看

#3

gs25367856782019-12-23 09:20

估计需要自创，自定义函数了

#4

pjtyzyq2019-12-23 14:29

百以内：
Clear
x1="一百二十"
ab=""
?Len(x1)
For i=Len(x1)-1 To 1 Step -2
    x2=Substr(x1,i,2)
    If i=Len(x1)-1 And x2="十" Then
        ab="0"
    ENDIF
    IF AT("百",x2)>0 AND  AT("十",x2)=0 AND LEN(alltrim(ab))=0 THEN
        ab="00"
    endif
    Do Case
    Case x2="一"
        ab="1"+ab
    Case x2="二"
        ab="2"+ab
    Case x2="三"
        ab="3"+ab
    Case x2="四"
        ab="4"+ab
    Case x2="五"
        ab="5"+ab
    Case x2="六"
        ab="6"+ab
    Case x2="七"
        ab="7"+ab
    Case x2="八"
        ab="8"+ab
    Case x2="九"
        ab="9"+ab
    Case x2="零" AND i<>1
        ab="0"+ab
    Endcase
Endfor
?x1,ab

[此贴子已经被作者于2019-12-23 14:46编辑过]

#5

wengjl2019-12-23 15:02

以下是引用pjtyzyq在2019-12-23 14:29:29的发言：

百以内：
Clear
x1="一百二十"
ab=""
?Len(x1)
For i=Len(x1)-1 To 1 Step -2
    x2=Substr(x1,i,2)
    If i=Len(x1)-1 And x2="十" Then
        ab="0"
    ENDIF
    IF AT("百",x2)>0 AND  AT("十",x2)=0 AND LEN(alltrim(ab))=0 THEN
        ab="00"
    endif
    Do Case
    Case x2="一"
        ab="1"+ab
    Case x2="二"
        ab="2"+ab
    Case x2="三"
        ab="3"+ab
    Case x2="四"
        ab="4"+ab
    Case x2="五"
        ab="5"+ab
    Case x2="六"
        ab="6"+ab
    Case x2="七"
        ab="7"+ab
    Case x2="八"
        ab="8"+ab
    Case x2="九"
        ab="9"+ab
    Case x2="零" AND i<>1
        ab="0"+ab
    Endcase
Endfor
?x1,ab

#6

xuminxz2019-12-23 18:19

完全通用的比较难，数据的范围是什么？写法有没有规范？例如，180是写成了一百八十还是也可以写成一百八？
如果比较规范，可以先用 ratc 函数取出最后一个字符,将其中的十、百、千、万分别改为字符0、00、000、0000等，再删除剩下的十、百、千、万，再将其它10个字分别用数字代换。最后将字符串改为数值。
可以用 STRTRAN( ) val() 函数

#7

sdta2019-12-24 21:05

回复 4楼 pjtyzyq

x1 = "十"
结果
ab = 0

#8

pjtyzyq2019-12-25 07:47

回复 7楼 sdta

,确实有问题，写法需要规范才可以，谢谢！
补救一下：
    If Len(x1)=2 And x2="十"  Then
        ab="10"
        Loop
    Endif

[此贴子已经被作者于2019-12-25 08:15编辑过]

#9

厨师王德榜2019-12-27 16:34

这个问题蛮有趣，那天看到了就想做一做，但是当时是在同事电脑上做的，他的电脑没有VFP，只有EXCEL，就用VBA来做了，结果事情多，断断续续折腾了两天才勉强搞定。
大家不要纠结用什么语言来做，算法搞清了，用什么语言都无所谓。
这是测试的结果：

只有本站会员才能查看附件，请登录

#10

厨师王德榜2019-12-27 16:39

这一楼放VBA代码，有兴趣的可以翻译为VFP代码。

程序代码：

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

#11

厨师王德榜2019-12-27 16:49

用法:

只有本站会员才能查看附件，请登录

把代码放出来，一是大家共同学习，共同提高。
二是这个代码还没有经过更严格的测试，希望大家能发现问题、解决问题。

#12

schtg2019-12-27 18:57

@厨师王德榜，谢谢分享！

#13

wengjl2020-11-05 09:57

@厨师王德榜，感谢分享！