[原创]与[推荐]数字金额转换中文大写与英文字母

嫦娥仙子

晕，怎么不能运行呢？楼主，你的代码能加载到宏里面吗？

jasonlodge74

东东本是好东东，只是不知是怎做的，没有多大意义，学不了什么？不知是我没发现还是本来就如此!

zhchgao

谢谢,学习学习

northwolves

以前俺也写过一个，与大家共享：

http://dev.csdn.net/develop/article/28/28433.shtm

ChinaOBS

不能自动重新计算！！！！

看看这个吧。点一下，数字变成了大写，再点一下，又恢复到原来的数字。而且支持自动重新计算。

[此贴子已经被作者于2005-12-13 21:27:13编辑过]

lim5200

做得好! 转化英文的怎么不能表示负数? 楼上的能否把你的代码上传让大家学习一下?

[此贴子已经被作者于2005-12-13 21:48:18编辑过]

jxsdslz

做成加载宏就可以自动重新计算.

ganganashw

试验了，很好用。谢谢

whitewood

好东东，谢谢！

烟雨厦江南

转贴(出处找不到了,向作者致歉): 今天整理文件时发现了以前写的货币金额中文转换（转换一亿亿元以下数目的货币）的代码，帖出来与大家共享： 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