[转帖]将汉字大写数字转换为阿拉伯数字的函数

zhuyiwen

作者：  黄河[4326340] 2001-04-29 18:18:18

'思路：
'1、将汉字金额字串截为:亿、万、仟、伯、拾、元、角、分捌个部份
'2、分别处理各部份数据，完成后亿部份乘以100000000，万部份乘以10000，仟部分乘以1000，佰部分乘以100，拾部份乘以10，元部部不处理，角部份乘以0.1，分部份乘以0.01.
'3、把各部份相加并输出
Public Function HZtoALB(strHZ As String) As Double
    Dim strTemp As String
    Dim lngPosition As Long
    Dim lngYi As Long
    Dim lngW As Long
    Dim lngQ As Long
    Dim lngB As Long
    Dim lngS As Long
    Dim lngY As Long
    Dim sngJ As Single
    Dim sngF As Single
    '截取亿部份
    lngPosition = InStr(1, strHZ, "亿")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
       lngYi = JQ(strTemp) * 100000000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取万部份
    lngPosition = InStr(1, strHZ, "万")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngW = JQ(strTemp) * 10000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取仟部份
    lngPosition = InStr(1, strHZ, "仟")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngQ = JQ(strTemp) * 1000
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取佰部份
    lngPosition = InStr(1, strHZ, "佰")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngB = JQ(strTemp) * 100
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取拾部份
    lngPosition = InStr(1, strHZ, "拾")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngS = JQ(strTemp) * 10
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取元部份
    lngPosition = InStr(1, strHZ, "元")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        lngY = JQ(strTemp) * 1
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取角部份
    lngPosition = InStr(1, strHZ, "角")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        sngJ = JQ(strTemp) * 0.1
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
    '截取分部份
    lngPosition = InStr(1, strHZ, "分")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strHZ, 1, lngPosition - 1)
        sngF = JQ(strTemp) * 0.01
       strHZ = Right(strHZ, Len(strHZ) - lngPosition)
    End If
   HZtoALB = lngYi + lngW + lngQ + lngB + lngS + lngY + sngJ + sngF
End Function

'计算每一段数值
Public Function JQ(strZ As String) As String
    Dim lngPosition As Long
    Dim strTemp As String
    Dim lngTemp As Long
    lngPosition = InStr(1, strZ, "仟")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, lngPosition - 1, 1)
       lngTemp = GetArabia(strTemp) * 1000
    End If
    lngPosition = InStr(1, strZ, "佰")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, (lngPosition - 1), 1)
       lngTemp = lngTemp + GetArabia(strTemp) * 100
    End If
    lngPosition = InStr(1, strZ, "拾")
    If Not IsNull(lngPosition) And Not lngPosition = 0 Then
       strTemp = Mid(strZ, lngPosition - 1, 1)
       lngTemp = lngTemp + GetArabia(strTemp) * 10
    End If
   strTemp = Right(strZ, 1)
   lngTemp = lngTemp + GetArabia(strTemp) * 1
    JQ = lngTemp
End Function
'转换汉字数字为阿拉伯数字
Public Function GetArabia(strZ As String) As Long
    Select Case strZ
        Case "壹"
           GetArabia = 1
        Case "贰"
           GetArabia = 2
        Case "叁"
           GetArabia = 3
        Case "肆"
           Ge

zhuyiwen

作者：  欧阳峰[48121454] 2001-05-03 00:03:11

以上是本人在实际编程中返回货币的英文大写的原代码
  调用函数为getcapital(stra as string),请各位大虾指点

Public Function strten(strt As String) As String
Dim strdim As String
Select Case Trim(strt)
  Case "0", "00"
     strdim = "ZERO"
  Case "1"
     strdim = "ONE"
  Case "2"
     strdim = "TWO"
  Case "3"
     strdim = "THREE"
  Case "4"
     strdim = "FOUR"
  Case "5"
     strdim = "FIVE"
  Case "6"
     strdim = "SIX"
  Case "7"
     strdim = "SEVEN"
  Case "8"
     strdim = "EIGHT"
  Case "9"
     strdim = "NINE"
  Case "10"
     strdim = "TEN"
  Case "11"
     strdim = "ELEVEN"
  Case "12"
     strdim = "TWELEVE"
  Case "13"
     strdim = "THIRTEEN"
  Case "14"
     strdim = "FOURTEEN"
  Case "15"
     strdim = "FIFTEEN"
  Case "16"
     strdim = "SIXTEEN"
  Case "17"
     strdim = "SEVENTEEN"
  Case "18"
     strdim = "EIGHTEEN"
  Case "19"
     strdim = "NINETEEN"
  Case "20"
     strdim = "TWENTY"
  Case "30"
     strdim = "THIRTY"
  Case "40"
     strdim = "FORTY"
  Case "50"
     strdim = "FIFTY"
  Case "60"
     strdim = "SIXTY"
  Case "70"
     strdim = "SEVENTY"
  Case "80"
     strdim = "EIGHTY"
  Case "90"
     strdim = "NINETY"
End Select
strten = strdim
End Function

Public Function strth(strb As String) As String
If Val(strb) <= 20 Then
  strth = strten(strb)
Else
  strth = strten(Left(strb, 1) & "0") & " " & strten(Right(strb, 1))
End If
End Function

Public Function getcapital(stra As String) As String
Dim strRe As String
strRe = ""
stra = Format(stra, "###########0.00")
If StrComp(Right(stra, 2), "00") <> 0 Then strRe = " AND CENTS " & strth(Right(stra, 2))
stra = Left(stra, Len(Trim(stra)) - 3)

If Len(stra) >= 2 Then
  strRe = strth(Right(stra, 2)) & strRe
   stra = Left(stra, Len(Trim(stra)) - 2)
Else
  strRe = strth(Right(stra, 1)) & strRe
   stra = ""
End If

If Len(stra) <= 0 Then
   Convision = strRe
   Exit Function
End If

strRe = strth(Right(stra, 1)) & " HUNDRED " & strRe
stra = Left(stra, Len(Trim(stra)) - 1)

If Len(stra) <= 0 Then
   Convision = strRe
   Exit Function
End If

strRe = " THOUSAND " & strRe
If Len(stra) >= 2 Then
  strRe = strth(Right(stra, 2)) & strRe
   stra = Left(stra, Len(Trim(stra)) - 2)
Else
  strRe = strth(Right(stra, 1)) & strRe
   stra = ""
End If

If Len(stra) <= 0 Then
   Convision = strRe
   Exit Function
End If

strRe = " HUNDRED " & strRe
strRe = strth(Right(stra, 1)) & strRe
stra = Left(stra, Len(stra) - 1)
If Len(stra) <= 0 Then
   Convision = strRe
   Exit Function
End If

strRe = " THOUSAND " & strRe
If Len(stra) >= 2 Then
  strRe = strth(Right(stra, 2)) & strRe
   stra = Left(stra, Len(Trim(stra)) - 2)
Else
  strRe = strth(Right(stra, 1)) & strRe
   stra = Left(stra, Len(Trim(stra)) - 1)
End If
If Len(stra) <= 0 Then
   Convision = strRe
   Exit Function
ElseIf Len(stra) <= 2 Then
   Convision = strth(stra) & " HUNDRED " & strRe
   Exit Function
Else
   MsgBox "数据超出范围", vbOKOnly, "information"
End If
End Function

[em26]

ui

好好，现在转来转去都齐了

HG

老朱多謝!我的英文金額轉換程式一直都有一個小錯誤,就是不能在循環中判斷,並合理的按三位來值,因最有些忙,所以也沒調試了,今天你轉了這貼,我也不想去調試了,拿來主義.多多謝!
這個英文的金額轉換是不能用的,應該是個半成品吧?

[此贴子已经被HG于2002-7-22 12:09:21编辑过]

zhuyiwen

你可以找原作者：欧阳峰[QQ：48121454]

原贴链接

http://bbs.tencent.com/cgi-bin/b ... 7/&st=0&sc=

[此贴子已经被zhuyiwen于2002-8-3 11:47:16编辑过]

HG

天呀,歐陽峰,我敢嗎?我又不是黃老邪.
誰想看看我的英文金額轉換代碼,幫我改一改.
現在的情況是,只能轉換長度為三的倍數的金額.如長度為3們以下,6,9,12都可以,
但4位,5,7,8位還有bug.

zhuyiwen

此函数的确存在问题，请勿用。如有能者，请辅正。现更正没有结果返回的错误，另，其中算法及范围有问题。

Public Function strTen(strT As String) As String
    Dim strDim As String
   
    Select Case Trim(strT)
        Case "0", "00"
            strDim = "ZERO"
        Case "1"
            strDim = "ONE"
        Case "2"
            strDim = "TWO"
        Case "3"
            strDim = "THREE"
        Case "4"
            strDim = "FOUR"
        Case "5"
            strDim = "FIVE"
        Case "6"
            strDim = "SIX"
        Case "7"
            strDim = "SEVEN"
        Case "8"
            strDim = "EIGHT"
        Case "9"
            strDim = "NINE"
        Case "10"
            strDim = "TEN"
        Case "11"
            strDim = "ELEVEN"
        Case "12"
            strDim = "TWELEVE"
        Case "13"
            strDim = "THIRTEEN"
        Case "14"
            strDim = "FOURTEEN"
        Case "15"
            strDim = "FIFTEEN"
        Case "16"
            strDim = "SIXTEEN"
        Case "17"
            strDim = "SEVENTEEN"
        Case "18"
            strDim = "EIGHTEEN"
        Case "19"
            strDim = "NINETEEN"
        Case "20"
            strDim = "TWENTY"
        Case "30"
            strDim = "THIRTY"
        Case "40"
            strDim = "FORTY"
        Case "50"
            strDim = "FIFTY"
        Case "60"
            strDim = "SIXTY"
        Case "70"
            strDim = "SEVENTY"
        Case "80"
            strDim = "EIGHTY"
        Case "90"
            strDim = "NINETY"
    End Select
    strTen = strDim
End Function

Public Function strTh(strB As String) As String
    If Val(strB) <= 20 Then
        strTh = strTen(strB)
    Else
        strTh = strTen(Left(strB, 1) & "0") & " " & strTen(Right(strB, 1))
    End If
End Function

Public Function Convision(strA As String) As String
    Dim strRe As String
   
    strRe = ""
    strA = Format(strA, "###########0.00")
   
    If StrComp(Right(strA, 2), "00") <> 0 Then strRe = " AND CENTS " & strTh(Right(strA, 2))
   
    strA = Left(strA, Len(Trim(strA)) - 3)
   
    If Len(strA) >= 2 Then
        strRe = strTh(Right(strA, 2)) & strRe
        strA = Left(strA, Len(Trim(strA)) - 2)
    Else
        strRe = strTh(Right(strA, 1)) & strRe
        strA = ""
    End If
   
    If Len(strA) <= 0 Then
        Convision = strRe
        Exit Function
    End If
   
    strRe = strTh(Right(strA, 1)) & " HUNDRED " & strRe
    strA = Left(strA, Len(Trim(strA)) - 1)
   
    If Len(strA) <= 0 Then
        Convision = strRe
        Exit Function
    End If
   
    strRe = " THOUSAND " & strRe
    If Len(strA) >= 2 Then
        strRe = strTh(Right(strA, 2)) & strRe
        strA = Left(strA, Len(Trim(strA)) - 2)
    Else
        strRe = strTh(Right(strA, 1)) & strRe
        strA = ""
    End If
   
    If Len(strA) <= 0 Then
        Convision = strRe
        Exit Function
    End If
   
    strRe = " HUNDRED " & strRe
    strRe = strTh(Right(strA, 1)) & strRe
    strA = Left(strA, Len(strA) - 1)
    If Len(strA) <= 0 Then
        Convision = strRe
        Exit Function
    End If
   
    strRe = " THOUSAND " & strRe
    If Len(strA) >= 2 Then
        strRe = strTh(Right(strA, 2)) & strRe
        strA = Left(strA, Len(Trim(strA)) - 2)
    Else
        strRe = strTh(Right(strA, 1)) & strRe
        strA = Left(strA, Len(Trim(strA)) - 1)
    End If
    If Len(strA) <= 0 Then
        Convision = strRe
        Exit Function
    ElseIf Len(strA) <= 2 Then
        Convision = strTh(strA) & " HUNDRED " & strRe
        Exit Function
    Else
        MsgBox "数据超出范围", vbOKOnly, "information"
    End If
End Function
[em26]

zhuyiwen

我的想法是整数按节处理，小数部份单个处理。有谁试试？

不过这种函数对我来说，一般用不上，所以不想深研。[em26]

HG

我的已上傳,誰有興趣可以看源碼?(bug還末全消除)
ftp://access-cn@office-cn.net/hg.mdb
歡迎大家多參於.裡迥好東東很多.

secowu

怎么没人搞呢？