人民币大写金额函数

来源:互联网 发布:依云订水软件 编辑:程序博客网 时间:2024/05/16 19:12
Public Function rmb(num As Double) As String '  
    num = FormatNumber(num, 2)
    Dim numList As String
    Dim rmbList As String
    Dim numLen
    Dim numChar
    Dim n1, n2 As String
    numList = "零壹贰叁肆伍陆柒捌玖"
    rmbList = "分角元拾佰仟万拾佰仟亿拾佰仟万"
   
    If num > 9999999999999.99 Then
        rmb = "超出范围的人民币值"
        Exit Function
    End If
   
    numStr = CStr(num * 100)
    'MsgBox numStr
    numLen = Len(numStr)
    'MsgBox numLen
    i = 1
    Do While i <= numLen
        numChar = CInt(Mid(numStr, i, 1))
        'MsgBox numChar
        n1 = Mid(numList, numChar + 1, 1)
        n2 = Mid(rmbList, numLen - i + 1, 1)
        If Not n1 = "零" Then
            hz = hz + CStr(n1) + CStr(n2)
        Else
            If n2 = "亿" Or n2 = "万" Or n2 = "元" Or n1 = "零" Then
                Do While Right(hz, 1) = "零"
                hz = Left(hz, Len(hz) - 1)
                Loop
            End If
            If (n2 = "亿" Or (n2 = "万" And Right(hz, 1) <> "亿") Or n2 = "元") Then
                hz = hz + CStr(n2)
            Else
                If Left(Right(hz, 2), 1) = "零" Or Right(hz, 1) <> "亿" Then
                    hz = hz + n1
                End If
            End If
        End If
        i = i + 1
    Loop
    Do While Right(hz, 1) = "零"
        hz = Left(hz, Len(hz) - 1)
    Loop
    If Right(hz, 1) = "元" Then
        hz = hz + "整"
    End If
    rmb = hz
End Function
原创粉丝点击