[原创]数字金额转换成中文大写金额的函数

kmwell

上传一个数字金额转换成中文大写金额的函数

Public Function MoneyConv(Money As Currency) As String
On Error GoTo Doerr

    Dim CN(9) As String
    Dim CU(15) As String
    Dim Temp As String, strNum As String
    Dim CM As String
    Dim tFirst As String, tEnd As String
    Dim i As Long, j As Long, k As Long   
    CN(0) = "零"
    CN(1) = "壹"
    CN(2) = "贰"
    CN(3) = "叁"
    CN(4) = "肆"
    CN(5) = "伍"
    CN(6) = "陆"
    CN(7) = "柒"
    CN(8) = "捌"
    CN(9) = "玖"
   
'    CU(0) = "分"
'    CU(1) = "角"
    CU(0) = "圆"
    CU(1) = "十"
    CU(2) = "佰"
    CU(3) = "仟"
    CU(4) = "万"
    CU(5) = "十"
    CU(6) = "佰"
    CU(7) = "仟"
    CU(8) = "亿"
    CU(9) = "十"
    CU(10) = "佰"
    CU(11) = "仟"
   
    If Money = 0 Then
        CM = "零圆整"
        GoTo Complete
    End If
    strNum = Trim(str(FormatCurrency(Money, 2, vbTrue, vbFalse, vbFalse)))   
    If Left(strNum, 1) = "-" Then
        tFirst = "负"
        strNum = Right(strNum, Len(strNum) - 1)
    Else
        tFirst = ""
    End If
   
    i = InStrRev(strNum, ".")
    If i <> 0 Then
        Temp = Right(strNum, i)
        If Len(strNum) - i = 1 Then Temp = Temp + "0"
        CM = CN(CInt(Left(Right(Temp, 2), 1))) + "角" + CN(CInt(Right(Temp, 1))) + "分"
        tEnd = ""
        strNum = Left(strNum, i - 1)
    Else
        tEnd = "整"
    End If
   
    i = 0
    For j = Len(strNum) To 1 Step -1
        k = CInt(Right(Left(strNum, j), 1))
        If k = 0 Then
            If i <> 0 And i <> 4 And i <> 8 Then
                CM = CN(k) + CM
            Else
                CM = CN(k) + CU(i) + CM
            End If
        Else
            CM = CN(k) + CU(i) + CM
        End If
'        CM = CN(k) + CU(i) + CM
        i = i + 1
    Next j
   
    CM = tFirst + CM + tEnd
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "亿零万零圆", "亿圆")
    CM = Replace(CM, "亿零万", "亿零")
    CM = Replace(CM, "万零圆", "万圆")
    CM = Replace(CM, "零亿", "亿")
    CM = Replace(CM, "零万", "万")
    CM = Replace(CM, "零圆", "圆")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")        '重复替换一次

Complete:
    Gerr = 0              '操作成功,无错误发生
    MoneyConv = CM
    Exit Function   
Doerr:
    Gerr = -1              '未知错误
Errexit:
    MoneyConv = ""
End Function[em07][em07]

yhl091122

谢谢

WFH6898

代码非常实用啊

lbq727

很需要

junta

怎样使用呢

cosby

好贴,我正需要的....

jicheng

搜索一下例子有好多

eyewitnes

仅供参考

Public Function URmb(ByVal Money As Currency) As String
'一个简单的小写金额转中文的函数

'作者: 海狸先生

Dim i As Integer, strMoney As String
   
   strMoney = StrReverse(Format(Money, "#.##") * 100)
   
   If Len(strMoney) > 14 Then MsgBox "超出范围！": Exit Function

   For i = 1 To Len(strMoney)
      URmb = Mid$("零壹贰叁肆伍陆柒捌玖", Mid$(strMoney, i, 1) + 1, 1) & Mid$("分角元拾佰仟万拾佰仟亿拾佰仟", i, 1) & URmb
   Next

End Function

wandiansong

555

yefei80

电风扇电风扇电风扇