[转载]Excel中读出大写金额的函数
关键词: Excel 人民币 大写 金额 函数
将下列函数复制到Excel中的工程模块中,可以使用:
=NounOfAmount("人民币",35103.27)
得到人民币叁万伍仟壹佰零叁元贰角柒分,使用:
=NounOfAmount("人民币",1000001.00)
得到人民币壹佰万零壹元整
NounOfAmount调用ChineseNumber来读整数部分,小数部分只能处理角分两位。大写金额的读法符合人民银行《现金支付办法》的要求。
ChineseNumber函数接收一个文本正整数参数(前面可加零),会读出正确的大写,最多可处理128位,如
=ChineseNumber("1"&REPT("0",127)),结果是“壹仟万亿兆京垓”。
该计数方法,壹仟亿再乘拾,结果是壹万亿。壹千万亿再乘拾结果为壹兆。壹千万亿兆再乘拾结果是壹京,下一个单位是垓。实际金额并不可能这么大,只是这个程序展示了递归算法如何处理上乘读数法。
具体算法是算出给定数字的最大基数单位,然后左右各分一半,再次调用读数程序,直到这个数小于5位,属于反复出现的小基数单位一级的仟佰拾时,进行万位以下读数处理。处理有零的情况有兴趣的同志自行研究。
背景资料,计数法。
中国古代的数学书上记录了三种不同的计数法,下乘、中乘、上乘。
下乘:
10万为1亿,10亿为1兆,10兆为1京。
1一
10一十
100一百
1000一千
10000一万
100000一亿
1000000一兆
10000000一京
......
中乘:
10000万为1亿,1万亿为1兆,1万兆为1京。
1一
10一十
100一百
1000一千
10000一万
100000一十万
1000000一百万
10000000一千万
100000000一亿
1000000000一十亿
10000000000一百亿
100000000000一千亿
1000000000000一兆
10000000000000一十兆
100000000000000一百兆
1000000000000000一千兆
10000000000000000一京
......
上乘:
1万万为亿,1亿亿为1兆,1兆兆为1京。
1一
10一十
100一百
1000一千
10000一万
100000一十万
1000000一百万
10000000一千万
100000000一亿
1000000000一十亿
10000000000一百亿
100000000000一千亿
1000000000000一万亿
10000000000000一十万亿
100000000000000一百万亿
1000000000000000一千万亿
10000000000000000一兆
100000000000000000一十兆
1000000000000000000一百兆
10000000000000000000一千兆
100000000000000000000一万兆
1000000000000000000000一十万兆
10000000000000000000000一百万兆
100000000000000000000000一千万兆
1000000000000000000000000一亿兆
10000000000000000000000000一拾亿兆
100000000000000000000000000一佰亿兆
1000000000000000000000000000一仟亿兆
10000000000000000000000000000一万亿兆
100000000000000000000000000000一十万亿兆
1000000000000000000000000000000一百万亿兆
10000000000000000000000000000000一千万亿兆
100000000000000000000000000000000一京
......
Option Base 0
Option Explicit
Function ChineseNumber(Number)
ChineseNumber = ""
Dim DigitName(9), SubBaseName(4), BaseName(4)
DigitName(0) = "零"
DigitName(1) = "壹"
DigitName(2) = "贰"
DigitName(3) = "叁"
DigitName(4) = "肆"
DigitName(5) = "伍"
DigitName(6) = "陆"
DigitName(7) = "柒"
DigitName(8) = "捌"
DigitName(9) = "玖"
SubBaseName(1) = "拾"
SubBaseName(2) = "佰"
SubBaseName(3) = "仟"
BaseName(0) = "万"
BaseName(1) = "亿"
BaseName(2) = "兆"
BaseName(3) = "京"
BaseName(4) = "垓"
Dim Length, BaseLevel, Point
Dim LeftLength, RightLength
Dim LeftStr, RightStr
Dim iCount, Char
Length = Len(Number)
If Length < 5 Then
For iCount = 1 To Length
Char = (Mid(Number, iCount, 1))
If Char <> "0" Then
Point = Length - iCount
ChineseNumber = ChineseNumber + DigitName(Val(Char)) + SubBaseName(Point)
If Point <> 0 Then
If Mid(Number, iCount + 1, 1) = "0" Then
If Right(Number, Point) <> String(Point, "0") Then
ChineseNumber = ChineseNumber + DigitName(0)
End If
End If
End If
End If
Next
Else
BaseLevel = Int(Log(Int((Length - 1) / 4)) / Log(2))
RightLength = 2 ^ BaseLevel * 4
LeftLength = Length - RightLength
LeftStr = ChineseNumber(Left(Number, LeftLength))
RightStr = ChineseNumber(Right(Number, RightLength))
If LeftStr <> "" Then
ChineseNumber = ChineseNumber + LeftStr + BaseName(BaseLevel)
If (Mid(Number, LeftLength + 1, 1) = "0" Or Mid(Number, LeftLength, 1) = "0") And RightStr <> "" Then
ChineseNumber = ChineseNumber + DigitName(0)
End If
End If
ChineseNumber = ChineseNumber + RightStr
End If
End Function
Function NounOfAmount(Curren, Amount)
Dim t, r, t2, lname(10)
lname(0) = ""
lname(1) = "壹"
lname(2) = "贰"
lname(3) = "叁"
lname(4) = "肆"
lname(5) = "伍"
lname(6) = "陆"
lname(7) = "柒"
lname(8) = "捌"
lname(9) = "玖"
lname(10) = "拾"
r = ""
If Amount = 0 Then
NounOfAmount = "零元整"
Else
t = Trim(Str(Amount * 100))
r = Curren + ChineseNumber(Left(t, Len(t) - 2))
t2 = Right(t, 2)
If t2 = "00" Then
r = r + "元整"
Else
r = r + "元"
If Left(t2, 1) = "0" Then
r = r + "零" + lname(Val(Right(t2, 1))) + "分"
ElseIf Right(t2, 1) = "0" Then
r = r + lname(Val(Left(t2, 1))) + "角"
Else
r = r + lname(Val(Left(t2, 1))) + "角" + lname(Val(Right(t2, 1))) + "分"
End If
End If
NounOfAmount = r
End If
End Function