Function daxie(money As String) As String 'Dim x As String, y As StringConst zimu = ".sbqwsbqysbqwsbq" '定义位置代码Const letter = "0123456789sbqwy.jzf" '定义数字及汉字缩写Const upcase = "零壹贰叁肆伍陆柒捌玖拾佰仟万亿圆角整分" '定义大写汉字Dim temp As Stringtemp = moneyIf 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) - 3y = y & Mid(x, i, 1) & Mid(zimu, Len(x) - 2 - i, 1)NextIf Right(x, 3) = ".00" Theny = y & "z"
'***元整Else y = y & Left(Right(x, 2), 1) & "j" & Right(x, 1) & "f"
'*元*角*分 End Ify = Replace(y, "0q", "0") '避免零千(如：40200肆万零千零贰佰)y = Replace(y, "0b", "0") '避免零百(如：41000肆万壹千零佰)y = Replace(y, "0s", "0") '避免零十(如：204贰佰零拾零肆)y = Replace(y, "0j", "0")'避免零角y = Replace(y, "0f", "整")Do While yReplace(y, "00", "0")y = Replace(y, "00", "0") '避免双零(如：1004壹仟零零肆)Loopy = 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 19y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字Nextdaxie = yEnd FunctionPrivate Sub Command1_Click() Text2.Text = daxie(Val(Text1.Text)) ' (如return: 贰玖仟叁佰贰拾贰圆叁角贰分End Sub |
