源码 订阅所有源码的日志

金额大小写转换(两种方法)

作者:JiaJia 日期:2008-02-07

字体大小: 小 中 大
复杂精确型
引用内容 引用内容

'   本模块生成汉字大写的金额
'
Option Explicit
'   名称：   CCh
'           得到一位数字   N1   的汉字大写
'           0   返回   ""
Function CCh(N1) As String
    Select Case N1
    Case 0
            CCh = "零"
    Case 1
            CCh = "壹"
    Case 2
            CCh = "贰"
    Case 3
            CCh = "叁"
    Case 4
            CCh = "肆"
    Case 5
            CCh = "伍"
    Case 6
            CCh = "陆"
    Case 7
            CCh = "柒"
    Case 8
            CCh = "捌"
    Case 9
            CCh = "玖"
    End Select
End Function   '()Function

'名称：   ChMoney
'         得到数字   N1   的汉字大写
'         最大为   千万位
'         O   返回   ""
Public Function ChMoney(N1) As String
    Dim tMoney     As String
    Dim lMoney     As String
    Dim tn     '小数位置
    Dim ST1     As String
    Dim T1     As String
    Dim s1     As String     '临时STRING   小数部分
    Dim s2     As String     '1000   以内
    Dim s3     As String     '10000
    
    
    
    If N1 = 0 Then
            ChMoney = "   "
            Exit Function
    End If
    If N1 < 0 Then
            ChMoney = "负" + ChMoney(Abs(N1))
            Exit Function
    End If
    tMoney = Trim(Str(N1))
            tn = InStr(tMoney, ".")     '小数位置
            s1 = ""
    If tn <> 0 Then
            ST1 = Right(tMoney, Len(tMoney) - tn)
            If ST1 <> "" Then
              T1 = Left(ST1, 1)
              ST1 = Right(ST1, Len(ST1) - 1)
                If T1 <> "0" Then
                  s1 = s1 + CCh(Val(T1)) + "角"
                End If
                If ST1 <> "" Then
                  T1 = Left(ST1, 1)
                  s1 = s1 + CCh(Val(T1)) + "分"
                End If
            End If
            ST1 = Left(tMoney, tn - 1)
    Else
            ST1 = tMoney
    End If
      
    s2 = ""
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            s2 = CCh(Val(T1)) + s2
    End If
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s2 = CCh(Val(T1)) + "拾" + s2
            Else
              If Left(s2, 1) <> "零" Then s2 = "零" + s2
            End If
    End If
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s2 = CCh(Val(T1)) + "佰" + s2
            Else
              If Left(s2, 1) <> "零" Then s2 = "零" + s2
            End If
    End If
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s2 = CCh(Val(T1)) + "仟" + s2
            Else
              If Left(s2, 1) <> "零" Then s2 = "零" + s2
            End If
    End If
    
    s3 = ""
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            s3 = CCh(Val(T1)) + s3
    End If
    
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s3 = CCh(Val(T1)) + "拾" + s3
            Else
              If Left(s3, 1) <> "零" Then s3 = "零" + s3
            End If
    End If
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s3 = CCh(Val(T1)) + "佰" + s3
            Else
              If Left(s3, 1) <> "零" Then s3 = "零" + s3
            End If
    End If
    
    If ST1 <> "" Then
            T1 = Right(ST1, 1)
            ST1 = Left(ST1, Len(ST1) - 1)
            If T1 <> "0" Then
              s3 = CCh(Val(T1)) + "仟" + s3
            End If
    End If
    If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
      
    If Len(s3) > 0 Then
      
    If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
            s3 = s3 & "万"
    End If
    
    ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元整" & s1)
End Function



简单明了型
显示被隐藏内容 显示被隐藏内容

引用内容 引用内容

Function RMBChinese(ByVal Rmb As Double) As String
    On Error Resume Next
    Dim Rmbexp As String, Rmbda As String, Expda As String, Lent As Integer, Ntyp As Integer, Icnt As Integer, i As Integer, Trmb As String
    
    Rmb = Format(Rmb, "###0.00")
    If Rmb > 999999999999.99 Then
        RMBChinese = "需转换的金额整数长度超过了12位！"
        Exit Function
    End If
    
    Rmbexp = "分角元拾佰仟万拾佰仟亿拾佰仟"
    Rmbda = "零壹贰叁肆伍陆柒捌玖"
    Ntyp = 0
    Trmb = Replace(CStr(Format(Rmb, "0.00")), ".", "")
    
    If Left(Trmb, 1) = "-" Then
        Trmb = Mid(Trmb, 2)
        Ntyp = 1
    End If
    
    Expda = ""
    Icnt = Len(Trmb)
    
    For i = 1 To Icnt
        Expda = Mid(Rmbda, Val(Mid(Trmb, Icnt - i + 1, 1)) + 1, 1) + IIf(Mid(Rmbexp, i, 1) = "元", Mid(Rmbexp, i, 1) + "  ", Mid(Rmbexp, i, 1)) + Expda
    Next
    RMBChinese = IIf(Ntyp = 1, "负" + Expda, Expda)
End Function




[本日志由 JiaJia 于 2008-02-07 11:21 PM 编辑]
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags: VB
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵　称:
密　码: 游客发言不需要密码.
内　容:
验证码: 验证码
选　项:
虽然发表评论不用注册，但是为了保护您的发言权，建议您注册帐号.