設為首頁收藏本站Access中國

Office中國論壇/Access中國論壇

 找回密碼
 注冊

QQ登錄

只需一步，快速開始

將金額數(shù)字轉成中文大寫

2015-5-25 16:08| 發(fā)布者: admin| 查看: 3153| 評論: 2|原作者: sin_g_y8888|來自: m.mzhfr.cn

摘要: Function Money(Number As Currency) Dim i, j, k, m, leng As Integer '計數(shù)器 Dim Zero As Integer '連續(xù)零標識 Dim Tnumber As String '儲存數(shù)字字符串,計算數(shù)組長度 Dim Num() As String '定義數(shù)組 ...
Function Money(Number As Currency)
    Dim i, j, k, m, leng As Integer '計數(shù)器
    Dim Zero As Integer '連續(xù)零標識
    Dim Tnumber As String '儲存數(shù)字字符串,計算數(shù)組長度
    Dim Num() As String '定義數(shù)組
    Dim Num1(3) As String '存儲萬元以下數(shù)字
    Dim Num2(1) As String '儲存拆分后的數(shù)字
    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,數(shù)據(jù)超過一億，暫不處理。")
        MsgBox ("順便問一下，你真有那么多錢嗎？")
        Money = "Sorry!"
    Else
        If (Number = 0) Then
            Money = "零元整"
        Else
            '*****將負數(shù)數(shù)字轉化正數(shù)并更改標識*****
            If (Number < 0) Then
                Number = Number * ( -1)
                Flag = False
            End If
            '*****小數(shù)點后超過兩位，則截斷*****
            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)
            '*****重新分配數(shù)組空間*****
            ReDim Num(Len(Tnumber) - 1) As String
            '*****將字符串分開存儲至數(shù)組中*****
            For i = 0 To Len(Tnumber) - 1
                Num(i) = Mid(Tnumber, i + 1, 1)
            Next i
            '*****定義所需字符*****
            Dim M1, M2
            M1 = Array("零", "壹", "貳", "叁", "肆", "伍", "陸", "柒", "捌", "玖")
            M2 = Array("", "拾", "佰", "仟", "萬", "億")
            '*****處理小于一元金額*****
            '*****小數(shù)點后一位，則*****
            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
                '*****小數(shù)點后兩位則*****
                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
            '*****分解大于一萬的整數(shù)部分*****
            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
            '*****轉換萬元以上數(shù)字*****
            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
            '*****轉換萬元以下數(shù)字*****
            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

發(fā)表評論

最新評論

引用 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, 2025-7-13 05:26 , Processed in 0.086147 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

返回頂部