设为首页收藏本站Access中国
开启辅助访问

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步，快速开始

Office中国论坛/Access中国论坛 › Access中国门户旧版 ›Access› 模块类函数VBA › 查看内容

将金额数字转成中文大写

2015-5-25 16:08| 发布者: admin| 查看: 2791| 评论: 2|原作者: sin_g_y8888|来自: www.office-cn.net

摘要: 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 '定义数组 ...
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
QQ截图20150525154228.png

大写.rar

收藏 分享 邀请
上一篇：Access判断计算机有否光驱下一篇：使窗体居中显示代码
发表评论

最新评论

引用 fjh 2015-5-25 16:22
常用的东东
引用 roych 2015-5-25 17:03
=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,,"零")),"零分","整")

查看全部评论(2)

相关分类

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

GMT+8, 2024-4-19 23:40 , Processed in 0.097577 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回顶部