[转载]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 0Option 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 IfEnd FunctionFunction 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 IfEnd Function
