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 ![]() ![]() |
|站長郵箱|小黑屋|手機版|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.