这段时间不少朋友在询问怎样把金额转换成大写的办法。本来坛子里已经有不少这方面的帖子了,为了避免重复发帖,特在此将论坛里关于这一问题的办法汇聚于此。当然,大家如果有什么新的思路和办法也可以在此跟帖。今后如果有类似提问将被指向此帖 假设A1单元格为原始数据 一、公式法一: =IF(A1=0,"零元整",IF(A1<0,"负",)&IF(INT(ABS(A1)),TEXT(INT(ABS(A1)),"[dbnum2]")&"元",)&IF(INT(ABS(A1)*10)-INT(ABS(A1))*10,TEXT(INT(ABS(A1)*10)-INT(ABS(A1))*10,"[dbnum2]")&"角",IF(INT(ABS(A1))=ABS(A1),,"零"))&IF(ROUND(ABS(A1)*100-INT(ABS(A1)*10)*10,),TEXT(ROUND(ABS(A1)*100-INT(ABS(A1)*10)*10,),"[dbnum2]")&"分","整")) 二、公式法二: =IF(A1<0,"负",)&TEXT(TRUNC(ABS(A1)),"[DBNum2]G/通用格式")&"元"&IF(ROUND(A1,3)=ROUND(A1,),"整",TEXT(RIGHT(TRUNC(A1*10),1),"[DBNum2]G/通用格式")&"角"&IF(ROUND(A1,3)=ROUND(A1,1),"整",TEXT(RIGHT(ROUND((A1*100),),1),"[DBNum2]G/通用格式")&"分")) 三、公式法三: =CONCATENATE(TEXT(INT(A1),"[DBNum2][$-804]G/通用格式")&"元"&IF((INT(A1*10)-INT(A1)*10)=0,"",TEXT(IF(AND(CEILING(A1*100,1)-INT(A1*10)*10=10,INT(A1*1000)-INT(A1*100)*10>=5),INT(A1*10)-INT(A1)*10+1,INT(A1*10)-INT(A1)*10),"[DBNum2][$-804]G/通用格式")&"角")&IF(OR(INT(A1*100)-INT(A1*10)*10=0,(IF(INT(A1*1000)-INT(A1*100)*10>=5,CEILING(A1*100,1)-INT(A1*10)*10=10,FALSE))),"整",(IF(INT(A1*1000)-INT(A1*100)*10>=5,(IF(CEILING(A1*100,1)-INT(A1*10)*10=10,"",(TEXT(CEILING(A1*100,1)-INT(A1*10)*10,"[DBNum2][$-804]G/通用格式")&"分"))),(TEXT(INT(A1*100)-INT(A1*10)*10,"[DBNum2][$-804]G/通用格式")&"分")))),"(¥",FIXED(A1,2,TRUE),"元)") 四、VBA代码法(自定义函数) Public Function BigNum(xiaoxie As Currency) Application.Volatile Dim fuhao As String fuhao = "" If xiaoxie < 0 Then xiaoxie = -xiaoxie fuhao = "负" End If If xiaoxie = 0 Then BigNum = "零元整" Else Const cNum = "零壹贰叁肆伍陆柒捌玖-万仟佰拾亿仟佰拾万仟佰拾元角分" Const cCha = "零仟零佰零拾零零零零零亿零万零元亿万零角零分零整-零零零零零亿万元亿零整整" BigNum = "" sNum = Trim(Str(Int(Round(xiaoxie, 2) * 100))) For i = 1 To Len(sNum) BigNum = BigNum + Mid(cNum, (Mid(sNum, i, 1)) + 1, 1) + Mid(cNum, 26 - Len(sNum) + i, 1) Next i For i = 0 To 11 BigNum = Replace(BigNum, Mid(cCha, i * 2 + 1, 2), Mid(cCha, i + 26, 1)) Next i BigNum = fuhao + BigNum End If End Function 上面四种办法中,方法一和方法四等价;方法二、三和方法一、四的区别只是整数部分为零时,方法一、四不显示“零元”,而直接显示“角分”;方法三在方法2的基础上加上了数字显示,下面是不同数据在四种方法中的显示结果: 原始数据 方法一 方法二 方法三 方法四 0.12 壹角贰分 零元壹角贰分 零元壹角贰分(¥0.12元) 壹角贰分 1.02 壹元零贰分 壹元零角贰分 壹元贰分(¥1.02元) 壹元零贰分 1001001 壹佰万壹仟零壹元整 壹佰万壹仟零壹元整 壹佰万壹仟零壹元整(¥1001001.00元) 壹佰万壹仟零壹元整 0 零元整 零元整 零元整(¥0.00元) 零元整 -25001 负贰万伍仟零壹元整 负贰万伍仟零壹元整 -贰万伍仟零壹元整(¥-25001.00元) 负贰万伍仟零壹元整 这个功能更强大、全面下面是转的其他朋友的VBA作品,功能更为强大: Public Function AAA(number As Variant) As String If (IsNull(number)) Then AAA = "错误:传入负值或Null值" Else Select Case number Case 0: AAA = "零" Case 1: AAA = "壹" Case 2: AAA = "贰" Case 3: AAA = "叁" Case 4: AAA = "肆" Case 5: AAA = "伍" Case 6: AAA = "陆" Case 7: AAA = "柒" Case 8: AAA = "捌" Case 9: AAA = "玖" Case 10 ^ 1: AAA = "分" Case 10 ^ 2: AAA = "角" Case 10 ^ 3: AAA = "元" Case 10 ^ 4, 10 ^ 8, 10 ^ 12: AAA = "拾" Case 10 ^ 5, 10 ^ 9, 10 ^ 13: AAA = "佰" Case 10 ^ 6, 10 ^ 10, 10 ^ 14: AAA = "仟" Case 10 ^ 7: AAA = "萬" Case 10 ^ 11: AAA = "亿" End Select End If End Function Public Function abc(number As Variant, canshu As Long) As String Dim C, D, Y, X, Z As String Dim A, b, k A = Int(number * 100 + 0.5) b = Len(CStr(A)) D = CStr(A) If (b > 14) Then MsgBox "数字过大无法转换": Exit Function If (number < 0) Then MsgBox "错误:不可传入负值": Exit Function If A = 0 Then abc = "": Exit Function For k = 1 To b Select Case canshu Case 1 Y = AAA(Mid(D, b - k + 1, 1)) + AAA(10 ^ k) Select Case k Case 1 If Mid(D, b, 1) = "0" Then C = "整" Else C = Y + C Case 2, 4, 5, 6, 8, 9, 10, 12, 13, 14 If Mid(D, b - k + 1, 2) = "00" Then C = C _ Else: _ If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" Then _ C = "零" + C Else: C = Y + C Case 7 If b >= 11 Then If Mid(D, b - k - 2, 4) = "0000" Then C = C Else If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End If Else If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End If Case 3, 11 If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) = "0" _ Then C = AAA(10 ^ k) + C _ Else: If Mid(D, b - k + 1, 1) = "0" And Mid(D, b - k + 2, 1) <> "0" _ Then C = AAA(10 ^ k) + "零" + C Else: C = Y + C End Select Case 2 C = AAA(Mid(D, b - k + 1, 1)) + " " + C Case 3 C = AAA(Mid(D, b - k + 1, 1)) + AAA(10 ^ k) + C End Select Next abc = C End Function 原文地址: http://www.office-cn.net/Article/Class5/Class16/200411/644.html |
|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )
GMT+8, 2024-4-29 21:25 , Processed in 0.068981 second(s), 16 queries .
Powered by Discuz! X3.3
© 2001-2017 Comsenz Inc.