實現貨幣金額中文大寫轉換的程式

2021-08-29 03:08:01 字數 1714 閱讀 8984

今天整理檔案時發現了以前寫的貨幣金額中文轉換**換一億億元以下數目的貨幣)的**,帖出來與大家共享:

function daxie(money as string) as string '

dim x as string, y as string

const zimu = ".sbqwsbqysbqwsbq" '定義位置**

const letter = "0123456789sbqwy.zjf" '定義漢字縮寫

const upcase = "零壹貳叄肆伍陸柒捌玖拾佰仟萬億圓整角分" '定義大寫漢字

dim temp as string

temp = money

if instr(temp, ".") > 0 then temp = left(temp, instr(temp, ".") - 1)

if len(temp) > 16 then msgbox "數目太大,無法換算!請輸入一億億以下的數字", 64, "錯誤提示": exit function '只能轉換一億億元以下數目的貨幣!

x = format(money, "0.00") '格式化貨幣

y = ""

for i = 1 to len(x) - 3

y = y & mid(x, i, 1) & mid(zimu, len(x) - 2 - i, 1)

next

if right(x, 3) = ".00" then

y = y & "z"          '***元整

else

y = y & left(right(x, 2), 1) & "j" & right(x, 1) & "f"     '*元*角*分

end if

y = replace(y, "0q", "0") '避免零千(如:40200肆萬零千零貳佰)

y = replace(y, "0b", "0") '避免零百(如:41000肆萬壹千零佰)

y = replace(y, "0s", "0") '避免零十(如:204貳佰零拾零肆)

do while y <> replace(y, "00", "0")

y = replace(y, "00", "0") '避免雙零(如:1004壹仟零零肆)

loop

y = replace(y, "0y", "y") '避免零億(如:210億     貳佰壹十零億)

y = replace(y, "0w", "w") '避免零萬(如:210萬     貳佰壹十零萬)

y = iif(len(x) = 5 and left(y, 1) = "1", right(y, len(y) - 1), y) '避免壹十(如:14壹拾肆;10壹拾)

y = iif(len(x) = 4, replace(y, "0.", ""), replace(y, "0.", ".")) '避免零元(如:20.00貳拾零圓;0.12零圓壹角貳分)

for i = 1 to 19

y = replace(y, mid(letter, i, 1), mid(upcase, i, 1)) '大寫漢字

next

daxie = y

end function

private sub command3_click()

debug.print  daxie("6218212212309322.3238") ' return: 陸仟貳佰壹拾捌萬貳仟壹佰貳拾貳億壹仟貳佰叄拾萬玖仟叄佰貳拾貳圓叄角貳分

end sub

實現貨幣金額中文大寫轉換的程式

今天整理檔案時發現了以前寫的貨幣金額中文轉換 換一億億元以下數目的貨幣 的 帖出來與大家共享 function daxie money as string as string dim x as string,y as string const zimu sbqwsbqysbqwsbq 定義位置 co...

實現貨幣金額中文大寫轉換的程式

今天整理檔案時發現了以前寫的貨幣金額中文轉換 換一億億元以下數目的貨幣 的 帖出來與大家共享 function daxie money as string as string dim x as string,y as string const zimu sbqwsbqysbqwsbq 定義位置 co...

實現貨幣金額中文大寫轉換的程式

function daxie money as string as string dim x as string,y as string const zimu sbqwsbqysbqwsbq 定義位置 const letter 0123456789sbqwy.zjf 定義漢字縮寫 const upc...