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

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]

bee2002

可是,我是菜鸟,实在不知道怎么一步步操作那?

bee2002

希望大侠能详细指导一下怎么操作,谢谢啊!

sblisb

做一个示例出来就好了

sblisb

例子在这里，里面有两个不同的函数，效果也不一样

楼主的是第二个例子

sblisb

觉得这两个函数做得不完美，

10.1元时，得出的是壹拾元壹角零分，最好不要体现零分，只要壹拾元壹角整就成

yefei80

电风扇电风扇电风扇

wandiansong

555

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

jicheng

搜索一下例子有好多