设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2674|回复: 2
打印 上一主题 下一主题

[函数/公式] 将金额数字转成中文大写

[复制链接]
跳转到指定楼层
1#
发表于 2015-5-24 10:56:04 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Function Money(Number As Currency)
    Dim i, j, k, m, leng As Integer '计数器
    Dim Zero As Integer '连续零标识
    Dim Tnumber As String '储存数字字符串,计算数组长度
    Dim Num() As String '定义数组
    Dim Num1(3) As String '存储万元以下数字
    Dim Num2(1) As String '储存拆分后的数字
    Dim Cha(8), Cha1(9), Cha2(4) As String '储存转化后的汉字
    Dim Zcha As String '连接后的字符串
    Dim Flag, Flag1 As Boolean '正负标志
    Flag = True
    Flag1 = False
    Zero = 0
    '如果大于一亿,则不处理
    If (Number > 99999999) Or (Number < -99999999) Then
        MsgBox ("Sorry,数据超过一亿,暂不处理。")
        MsgBox ("顺便问一下,你真有那么多钱吗?")
        Money = "Sorry!"
    Else
        If (Number = 0) Then
            Money = "零元整"
        Else
            '*****将负数数字转化正数并更改标识*****
            If (Number < 0) Then
                Number = Number * ( -1)
                Flag = False
            End If
            '*****小数点后超过两位,则截断*****
            If (((Number - Int(Number)) * 100 - Int((Number - Int(Number)) * 100)) > 0) Then
                Tnumber = CStr(Int(Number * 100) / 100)
            Else
                Tnumber = CStr(Number)
            End If
            '*****处理四舍五入*****
            If (((Number - Int(Number)) * 100 - Int((Number - Int(Number)) * 100)) >= 0.5) Then
                Tnumber = CStr((CCur(Tnumber)) + 0.01)
            End If
            Number = CCur(Tnumber)
            '*****重新分配数组空间*****
            ReDim Num(Len(Tnumber) - 1) As String
            '*****将字符串分开存储至数组中*****
            For i = 0 To Len(Tnumber) - 1
                Num(i) = Mid(Tnumber, i + 1, 1)
            Next i
            '*****定义所需字符*****
            Dim M1, M2
            M1 = Array("零", "壹", "贰", "叁", "肆", "伍", "陆", "柒", "捌", "玖")
            M2 = Array("", "拾", "佰", "仟", "万", "亿")
            '*****处理小于一元金额*****
            '*****小数点后一位,则*****
            If ((Number - Int(Number) > 0) And ((Number * 100 - Int(Number) * 100) Mod 10) = 0) Then
                i = i - 1
                Num2(0) = Num(i)
                Num(i) = ""
                i = i - 1
                Num(i) = ""
                i = i - 1
                Cha2(0) = M1(CByte(Num2(0)))
                Cha2(1) = "角"
                Cha2(2) = "整"
            Else
                '*****小数点后两位则*****
                If ((Number - Int(Number) > 0)) Then
                    i = i - 1
                    Num2(1) = Num(i)
                    Num2(0) = Num(i - 1)
                    Num(i) = ""
                    i = i - 1
                    Num(i) = ""
                    i = i - 1
                    Num(i) = ""
                    i = i - 1
                    Cha2(0) = M1(CByte(Num2(0)))
                    Cha2(1) = "角"
                    Cha2(2) = M1(CByte(Num2(1)))
                    Cha2(3) = "分"
                End If
            End If
            '*****分解大于一万的整数部分*****
            If (Int(Number) > 9999) Then
                If (Cha2(0) <> "") Then
                    i = i + 1
                End If
                For j = 3 To 0 Step -1
                    Num1(j) = Num(i - 1)
                    Num(i - 1) = ""
                    i = i - 1
                Next j
            Else
                If (Cha2(0) <> "") Then
                    i = i + 1
                End If
                For j = 0 To i - 1
                    Num1(j) = Num(j)
                    Num(j) = ""
                Next j
            End If
            '*****转换万元以上数字*****
            If (Num(0) <> "") Then
                leng = i
                j = 0
                For k = 0 To leng - 1
                    If (Num(k) = "0") Then
                        Zero = Zero + 1
                        For m = 1 To 5
                            If (Cha(j - 1) = M2(m)) Then
                                Flag1 = True
                            End If
                        Next m
                        If ((Zero = 1) And (Flag1 = False)) Then
                            Cha(j) = M1(CByte(Num(k)))
                        End If
                        If (Zero = 1) Then
                            j = j + 1
                        End If
                    Else
                        If (Num(k) <> "") Then
                            If (Zero > 0) Then
                                Cha(j - 1) = "零"
                            End If
                            Cha(j) = M1(CByte(Num(k)))
                        End If
                        j = j + 1
                    End If
                    If (Num(k) = "0") Then
                        i = i - 1
                    Else
                        Cha(j) = M2(i - 1)
                        j = j + 1
                        i = i - 1
                        Zero = 0
                    End If
                Next k
                Cha(j - 1) = "万"
                Zero = 0
            End If
            '*****转换万元以下数字*****
            If (Num1(0) <> "") Then
                j = 0
                Flag1 = False
                leng = 3
                While (Num1(leng) = "")
                    leng = leng - 1
                Wend
                i = leng + 1
                For k = 0 To leng
                    If (Num1(k) <> "") Then
                        If (Num1(k) = "0") Then
                            Zero = Zero + 1
                            For m = 1 To 5
                                If (j <> 0) Then
                                    If (Cha1(j - 1) = M2(m)) Then
                                        Flag1 = True
                                    End If
                                End If
                            Next m
                            If ((Zero = 1) And (Flag1 = False)) Then
                                Cha1(j) = M1(CByte(Num1(k)))
                            End If
                            If (Zero = 1) Then
                                j = j + 1
                            End If
                        Else
                            If (Num1(k) <> "") Then
                                If (Zero > 0) Then
                                    Cha1(j - 1) = "零"
                                End If
                                Cha1(j) = M1(CByte(Num1(k)))
                            End If
                            j = j + 1
                        End If
                        If (Num1(k) = "0") Then
                            i = i - 1
                        Else
                            Cha1(j) = M2(i - 1)
                            j = j + 1
                            i = i - 1
                            Zero = 0
                        End If
                    End If
                Next k
                Cha1(j - 1) = "元"
                If (Cha2(0) = "") Then
                    Cha1(j) = "整"
                End If
            End If
            '*****连接字符串*****
            j = 0
            While (Cha(j) <> "")
                Zcha = Zcha & Cha(j)
                j = j + 1
            Wend
            j = 0
            While (Cha1(j) <> "")
                Zcha = Zcha & Cha1(j)
                j = j + 1
            Wend
            j = 0
            While (Cha2(j) <> "")
                Zcha = Zcha & Cha2(j)
                j = j + 1
            Wend
            '*****最终显示*****
            If (Flag) Then
                Money = Zcha
            Else
                Money = "负" & Zcha
            End If
        End If
    End If
End Function




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2015-5-25 16:22:39 | 只看该作者
常用的东东
3#
发表于 2015-5-25 17:03:01 | 只看该作者
=SUBSTITUTE(SUBSTITUTE(IF(-RMB(A1,2),TEXT(A1,";负")&TEXT(INT(ABS(A1)+0.5%),"[dbnum2]G/通用格式元;;")&TEXT(RIGHT(RMB(A1,2),2),"[dbnum2]0角0分;;整"),),"零角",IF(A1^2<1,,"零")),"零分","整")
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-4-26 13:31 , Processed in 0.083854 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表