'例子:
'debug.print upnumber(-10556765765555.45,0,true )
'顯示為:
'負(fù)壹拾萬(wàn)伍仟伍佰陸拾柒億陸仟伍佰柒拾陸萬(wàn)伍仟伍佰伍拾伍圓肆角零分

public function upnumber(byval number as double, optional byval typ as long, optional byval ismoney as boolean) as string
'********************************************************************************
'--------------------------------------------------------------------------------
'將阿拉伯?dāng)?shù)字轉(zhuǎn)換為大寫(xiě)字符串
'version 1.0 2002-02-06
'version 1.1 2002-04-05 修改到支持到千億
'version 1.2 2004-08-14 修改為支持 typ,ismoney 參數(shù),轉(zhuǎn)換結(jié)果可以不是金額,支持到百萬(wàn)億
'roadbeg
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'參數(shù)說(shuō)明:
'number 待轉(zhuǎn)換的數(shù)字,可以是小數(shù).
'typ 轉(zhuǎn)換類(lèi)型,可選值 0,1
'0 轉(zhuǎn)換為 零,壹,貳 等
'1 轉(zhuǎn)換為 一,二,三 等
'ismoney 是否是金額,如果是,則轉(zhuǎn)換為多少元,小數(shù)后轉(zhuǎn)換為多少角,分,反之則轉(zhuǎn)換為類(lèi)似于"二點(diǎn)三"這種形式
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'返回值說(shuō)明:
'如果成功,返回轉(zhuǎn)換后的字符串
'如果失敗,返回空字符串
'--------------------------------------------------------------------------------
'
'--------------------------------------------------------------------------------
'注意,此函數(shù)最大只支持到百萬(wàn)億
'沒(méi)有對(duì) typ 的值進(jìn)行檢查,如果 typ 不為 0,1 之一,將會(huì)引發(fā)錯(cuò)誤.
'另,由于 double 類(lèi)型數(shù)值范圍的原因,超過(guò)百萬(wàn)億,將不能顯示小數(shù),同樣的超過(guò)十萬(wàn)億只能顯示一個(gè)小數(shù),以此類(lèi)推.
'--------------------------------------------------------------------------------
'********************************************************************************

on error goto doerr

dim result as string '返回值
dim strnumber as string '文本型的 number
dim lngnumberlen as long '文本型的 number 的 len

dim strtmp as string
dim strfirst as string, strend as string
dim lngi as long, lngj as long, lngtmp as long

dim strnum(10) as string '大寫(xiě)數(shù)字
dim strunit(16) as string '單位,比如 十,拾,萬(wàn)等
dim strunitb(2) as string '小數(shù)后的單位

'初始化
select case typ
case 0
strnum(0) = "零": strnum(1) = "壹": strnum(2) = "貳": strnum(3) = "叁": strnum(4) = "肆"
strnum(5) = "伍": strnum(6) = "陸": strnum(7) = "柒": strnum(8) = "捌": strnum(9) = "玖"

if ismoney then
strunit(0) = "圓"
strunitb(0) = "角": strunitb(1) = "分"
else
strunit(0) = "點(diǎn)"
end if

strunit(1) = "拾": strunit(2) = "佰": strunit(3) = "仟": strunit(4) = "萬(wàn)"
strunit(5) = "拾": strunit(6) = "佰": strunit(7) = "仟": strunit(8) = "億": strunit(9) = "拾"
strunit(10) = "佰": strunit(11) = "仟": strunit(12) = "萬(wàn)": strunit(13) = "拾": strunit(14) = "佰"
strunit(15) = "仟"

case 1
strnum(0) = "零": strnum(1) = "一": strnum(2) = "二": strnum(3) = "三": strnum(4) = "四"
strnum(5) = "五": strnum(6) = "六": strnum(7) = "七": strnum(8) = "八": strnum(9) = "九"

if ismoney then
strunit(0) = "元"
strunitb(0) = "角": strunitb(1) = "分"
else
strunit(0) = "點(diǎn)"
end if

strunit(1) = "十": strunit(2) = "百": strunit(3) = "千": strunit(4) = "萬(wàn)"
strunit(5) = "十": strunit(6) = "百": strunit(7) = "千": strunit(8) = "億": strunit(9) = "十"
strunit(10) = "百": strunit(11) = "千": strunit(12) = "萬(wàn)": strunit(13) = "十": strunit(14) = "百"
strunit(15) = "千"

case else
'參數(shù)錯(cuò)誤
goto errexit
end select

result = ""
if number = 0 then
if ismoney then
result = strnum(0) & strunit(0) & "整"
else
result = strnum(0)
end if
else
if ismoney then
strnumber = trim(str(formatcurrency(number, 2, vbtrue, vbfalse, vbfalse))) '保留兩位小數(shù)
else
strnumber = trim(str(number)) '簡(jiǎn)單的轉(zhuǎn)換為字符串型
end if
lngnumberlen = len(strnumber)

if left(strnumber, 1) = "-" then '處理負(fù)數(shù)
strfirst = "負(fù)"
strnumber = right(strnumber, lngnumberlen - 1)
lngnumberlen = lngnumberlen - 1
else
strfirst = "" '通常不需要 =""
end if

lngi = instrrev(strnumber, ".")
if lngi then
strtmp = right(strnumber, lngnumberlen - lngi)
if ismoney then
strtmp = strtmp & "00"
strend = "" '通常不需要 =""

for lngj = 1 to 2
result = result & strnum(clng(mid$(strtmp, lngj, 1))) & strunitb(lngj - 1)
next
else
strtmp = right(strnumber, lngnumberlen - lngi)
for lngj = 1 to lngnumberlen - lngi
result = result & strnum(clng(mid$(strtmp, lngj, 1)))
next
end if

strnumber = left(strnumber, lngi - 1) '去除小數(shù)部分
lngnumberlen = len(strnumber) '新的字符串長(zhǎng)度
else
if ismoney then
strend = "整"
else
strend = ""
end if
end if

'以下為主循環(huán)部分
lngi = 0
for lngj = lngnumberlen to 1 step -1
lngtmp = clng(mid$(strnumber, lngj, 1))

if lngtmp then
result = strnum(lngtmp) & strunit(lngi) & result
else
if lngi = 0 or lngi = 4 or lngi = 8 or lngi = 12 then '超過(guò) 16 位不支持
result = strnum(lngtmp) & strunit(lngi) & result
else
result = strnum(lngtmp) & result
end if
end if

lngi = lngi + 1
next

result = replace(result, strnum(0) & strnum(0), strnum(0)) '零零", "零
result = replace(result, strnum(0) & strnum(0), strnum(0)) '零零", "零

'億零萬(wàn)零圓", "億圓"
result = replace(result, strunit(8) & strnum(0) & strunit(4) & strnum(0) & strunit(0), strunit(8) & strunit(0))

result = replace(result, strunit(8) & strnum(0) & strunit(4), strunit(8) & strnum(0)) '億零萬(wàn), "億零"
result = replace(result, strunit(4) & strnum(0) & strunit(0), strunit(4) & strunit(0)) '億零萬(wàn)", "億零

result = replace(result, strnum(0) & strunit(8), strunit(8)) '零億
result = replace(result, strnum(0) & strunit(4), strunit(4)) '零萬(wàn)
result = replace(result, strnum(0) & strunit(0), strunit(0)) '零圓

result = replace(result, strnum(0) & strnum(0), strnum(0)) '零零", "零
result = replace(result, strnum(0) & strnum(0), strnum(0)) '零零", "零

if ismoney then
result = strfirst & result & strend
else
if right(result, 1) = strunit(0) then result = left(result, len(result) - 1) '去除最后一個(gè) "點(diǎn)"
end if
end if

complete:
goto quit
doerr:
errexit:
result = ""
quit:
upnumber = result
end function