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

山中无虎

谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! 谢谢Samsea! !!!完全可以!!!我很激动!!

另外,为何用鼠标点一下中文大写那一列的某个单元格之后,被点中的单元格就变成公式,再也无法变成中文大写了呢?

Samsea

问：为何用鼠标点一下中文大写那一列的某个单元格之后,被点中的单元格就变成公式,再也无法变成中文大写了呢?

答：把format Cells 改为 General.格式化单元格为普通.

山中无虎

再请教Samsea:关于中文大写的:78.90 能否转换成:"仟$佰柒拾捌元玖角零分" ? 如果是整数,如 100 就转换成:"万$仟壹佰零拾零元零角零分"?就象我们平时在填写格式固定的印刷本收据一样,可以自动对应"万\千\百\拾\元\角\分\等位置.币符要美元的.能够在你发在论坛上的那个附件里添加上这个功能么? 要如何感谢您? 我衷心的感激,不仅因为您的技术,更因为您乐于助人的精神!!!!

Samsea

QUOTE:

以下是引用山中无虎在2006-8-14 17:34:00的发言：
再请教Samsea:关于中文大写的:78.90 能否转换成:"仟$佰柒拾捌元玖角零分" ? 如果是整数,如 100 就转换成:"万$仟壹佰零拾零元零角零分"?就象我们平时在填写格式固定的印刷本收据一样,可以自动对应"万\千\百\拾\元\角\分\等位置.币符要美元的.能够在你发在论坛上的那个附件里添加上这个功能么? 要如何感谢您? 我衷心的感激,不仅因为您的技术,更因为您乐于助人的精神!!!!

试试看：  

5tweHxEp.zip (24.53 KB, 下载次数: 81)

2006-8-15 16:42 上传

点击文件名下载附件
[原创]与[推荐]数字金额转换中文大写与英文字母

liyong911

斑竹请问可以把0写成零吗？

[em06]

kwenlau

能给出源码吗,我现在急需啊!

jwb444

分享

我也有一个：

abc = Range("a1")
    If abc < 0 Then
        c = "负"
        abc = Abs(abc)
    End If
    abc = Round(abc * 100, 0)
    If abc >= 100 Then
        a = Left(abc, Len(abc) - 2)
        b = WorksheetFunction.Text(a, "[dbnum2]") & "元"
    End If
    If abc >= 10 Then
        a1 = Left(Right(abc, 2), 1)
        b1 = WorksheetFunction.Text(a1, "[dbnum2]") & "角"
    End If
    a2 = Right(abc, 1)
    b2 = WorksheetFunction.Text(a2, "[dbnum2]") & "分"
    If b1 = "零角" Then b1 = "零"
    If b2 = "零分" Then b2 = ""
    If b2 = "" And b1 = "零" Then b1 = ""
    bb = b & b1 & b2 & "整"
    MsgBox bb

Samsea

QUOTE:

以下是引用kwenlau在2006-11-27 15:31:00的发言：
能给出源码吗,我现在急需啊!

源码是开放的，下载文件中有源码。

chenfly76

很有用呀!

opiona

QUOTE:

以下是引用northwolves在2005-12-13 17:41:00的发言：

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

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

替版主贴出来代码：不要见怪啊！！！

今天整理文件时发现了以前写的货币金额中文转换（转换一亿亿元以下数目的货币）的代码，帖出来与大家共享：

 

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" '定义位置代码
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