VB编程求解啊~~中文大写数字转换成阿拉伯数字

[wahu484]

说明：
中文大写数字包括：一、二、三、……，壹、贰、叁、……，十、拾、百、佰、千、仟、万、……，等等。转换包括：一对一的转换，数值转换等。尽量考虑周全
全局变量：
Dim CData_Str(100) as char ‘作为保存上述特征字的数组。

函数定义：
Public Function Cdata_to_Num(CdataStr as string,NumStr as string) as integer
……
End function
定义说明：
CdataStr为输入的大写数字字符串，NumStr为输出的数字字符串。转换成功时，函数值为1，否则函数值为0。

[caprason]

[-晴天]

这可是要写上一段程序了.

[vbman2003]

有一个思路，刚才抽空简单写了一下，算是抛砖引玉吧
思路应该是可行的，细节可以慢慢完善

Option Explicit

Function Cdata_to_Num(ByVal CdataStr As String, ByRef NumStr As String) As Integer
 
    Dim i As Integer, Idx As Integer
    Dim sLeft As String, sRight As String
    Dim tmp As String, sTmp As String
    Dim rmbUnit, ChrNum, rmbNum, Num
    
    ChrNum = Array("○", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "千", "百")
    rmbNum = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖", "拾", "仟", "佰")
    rmbUnit = Array("兆", "仟", "佰", "拾", "亿", "仟", "佰", "拾", "万", "仟", "佰", "拾", "元")
    Num = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
    
    '统一大写
    For i = 0 To UBound(ChrNum)
        CdataStr = Replace(CdataStr, ChrNum(i), rmbNum(i))
    Next
    '数字转换为阿拉伯数字
    For i = 0 To UBound(Num)
        CdataStr = Replace(CdataStr, rmbNum(i), Num(i))
    Next
    '按元分组处理
    sLeft = Split(CdataStr, "元")(0) & "元"
    sRight = Split(CdataStr, "元")(1)
    '处理整数部分，将格式统一为"#亿#仟#佰#拾#万#仟#佰#拾#元"这样的格式
    sLeft = Replace(sLeft, "0", "")
    Idx = UBound(rmbUnit)
    For i = Len(sLeft) To 2 Step -1
        tmp = Mid(sLeft, i, 1)
        If Not IsNumeric(tmp) Then
            If tmp = rmbUnit(Idx) Then
                sTmp = Val(Mid(sLeft, i - 1, 1)) & tmp & sTmp
            Else
                sTmp = "0" & rmbUnit(Idx) & sTmp
                i = i + 1
            End If
            Idx = Idx - 1
        End If
    Next
    '合并左右，替换掉全部中文
    CdataStr = sTmp & sRight
    CdataStr = Replace(CdataStr, "元", ".")
    CdataStr = Replace(CdataStr, "角", vbNullString)
    CdataStr = Replace(CdataStr, "分", vbNullString)
    CdataStr = Replace(CdataStr, "整", vbNullString)
    For i = 0 To UBound(rmbUnit)
        CdataStr = Replace(CdataStr, rmbUnit(i), "")
    Next
    
    '输出
    NumStr = Format(CdataStr, "0.00")
    Cdata_to_Num = 1
    
End Function

Private Sub Command1_Click()
    Dim s As String, ss As String
    Dim i As Integer
    s = "一万零叁元零角陆分"
    i = Cdata_to_Num(s, ss)
    Debug.Print ss
End Sub

'结果：10003.06

[wahu484]

呵呵,很不错了啊已经

[lymxuexi]

感觉比较麻烦，用CASE 语句配合数组会简单些吗？

[嗷嗷叫的老马]

[Quote=引用楼主 wahu484 的帖子:]


说明：
中文大写数字包括：一、二、三、……，壹、贰、叁、……，十、拾、百、佰、千、仟、万、……，等等。转换包括：一对一的转换，数值转换等。尽量考虑周全
全局变量：
Dim CData_Str(100) as char ‘作为保存上述特征字的数组。

函数定义：
Public Function Cdata_to_Num(CdataStr as string,NumStr as string) as integer
……
End function
定义说明：
CdataStr为输入的大写数字字符串，…
[/Quote]

这好象是团队开发做好的接口调用

楼主想省事么.

[vbman2003]

数字转中文的好多，中文转数字的好象头次见
没时间写，先标记一下

[嗷嗷叫的老马]

...............路过.

[lymxuexi]

比前次的清爽了，呵呵

[vbman2003]

早上清醒点，改一下：

Option Explicit

Function Cdata_to_Num(ByVal CdataStr As String, ByRef NumStr As String) As Integer
 
    Dim i As Integer, Idx As Integer
    Dim tmp As String, sTmp As String
    Dim Char, CharUnit, rmbFormat, Num
    
    '别字列表
    Char = Array("○", "一", "二", "三", "四", "五", "六", "七", "八", "九", "十", "千", "百", "正")
    '标准字列表
    CharUnit = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖", "拾", "仟", "佰", "整")
    '中文人民币格式列表
    rmbFormat = Array("兆", "仟", "佰", "拾", "亿", "仟", "佰", "拾", "万", "仟", "佰", "拾", "元", "角", "分")
    Num = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)
    
    '统一大写标准
    For i = 0 To UBound(Char)
        CdataStr = Replace(CdataStr, Char(i), CharUnit(i))
    Next
    '数字转换为阿拉伯数字
    For i = 0 To UBound(Num)
        CdataStr = Replace(CdataStr, CharUnit(i), Num(i))
    Next
   
    '将格式统一为："#亿#仟#佰#拾#万#仟#佰#拾#元#角#分"
    CdataStr = Replace(CdataStr, "0", "")       '去掉0
    CdataStr = Replace(CdataStr, "整", "")      '去掉整
    '只有角分的情况要加上元
    If InStr(CdataStr, "元") = 0 Then
        CdataStr = "0元" & CdataStr
    End If
    Idx = UBound(rmbFormat) + 1
    For i = Len(CdataStr) To 2 Step -1
        tmp = Mid(CdataStr, i, 1)
        If Not IsNumeric(tmp) Then
            Do
                Idx = Idx - 1
                If tmp = rmbFormat(Idx) Then
                    sTmp = Val(Mid(CdataStr, i - 1, 1)) & tmp & sTmp
                    Exit Do
                Else
                    sTmp = "0" & rmbFormat(Idx) & sTmp
                End If
            Loop
        End If
    Next
    '替换掉全部中文
    sTmp = Replace(sTmp, "元", ".")
    For i = 0 To UBound(rmbFormat)
        sTmp = Replace(sTmp, rmbFormat(i), "")
    Next
    
    '输出
    NumStr = Format(sTmp, "0.00")
    Cdata_to_Num = 1
    
End Function

Private Sub Command1_Click()
    Dim s As String
    
    Call Cdata_to_Num("五亿元正", s)
    Debug.Print s
    Call Cdata_to_Num("一万零叁元零角陆分", s)
    Debug.Print s
    Call Cdata_to_Num("四拾壹亿叁仟陆百万零捌元", s)
    Debug.Print s
    Call Cdata_to_Num("玖分", s)
    Debug.Print s
    Call Cdata_to_Num("五角", s)
    Debug.Print s
    Call Cdata_to_Num("陆仟壹佰叁拾捌元五角一分", s)
    Debug.Print s
End Sub

结果：
500000000.00
10003.06
4136000008.00
0.09
0.50
6138.51

[wahu484]

[Quote=引用 8 楼 myjian 的回复:]
这好象是团队开发做好的接口调用

楼主想省事么.


真是说对了,无奈啊,以前没碰过VB

[wahu484]

有漏~

[vbman2003]

[Quote=引用 12 楼 wahu484 的回复:]
有漏~
[/Quote]

示例一下数据

[wahu484]

呵呵，也没什么，比如十，十八，十万的时候有错，加上去就可以了

[vbman2003]

哦，是啊，我只是个示例，代码不严谨的，要实际应用还要推敲优化的，呵呵......

[wahu484]

还可以请教你一下吗，如果是这样转换呢，输入，梁山一百零八好汉。输出：梁山108好汉，这样的思路你能跟我说说吗？？