在excel中把阿拉伯数字自动显示成人民币大写

合集下载
  1. 1、下载文档前请自行甄别文档内容的完整性,平台不提供额外的编辑、内容补充、找答案等附加服务。
  2. 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
  3. 3、如文档侵犯您的权益,请联系客服反馈,我们会尽快为您处理(人工客服工作时间:9:00-18:30)。

嘿嘿,把代码修改了一下下,精确到角的。

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, sign As String
If Left(money, 1) = "-" Then
money = Mid(money, 2)
sign = "负"
Else
sign = ""
End If
temp = money
If InStr(temp, ".") > 0 Then temp = Left(temp, InStr(temp, ".") - 1) If Len(temp) > 16 Then daxie = "数目太大,无法换算!": 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
If j <> "0" Then
y = y & Left(Right(x, 2), 1) & "j" & "z" '*元*角*分
Else
y = y & Left(Right(x, 2), 0) & "z"
End If
End If
y = Replace(y, "0q", "0") '避免零千(如:40200肆萬零千零贰佰)
y = Replace(y, "0b", "0") '避免零百(如:41000肆萬壹千零佰)
y = Replace(y, "0s", "0") '避免零十(如:204贰佰零拾零肆)
y = Replace(y, "0j", "0") '避免零角(如:204.02贰佰零肆元零角贰分)
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)
y = IIf(Len(x) = 4, Replace(y, "0.", ""), Replace(y, "0.", "."))
For i = 1 To 19
y = Replace(y, Mid(letter, i, 1), Mid(upcase, i, 1)) '大写汉字
Next
daxie = sign & y
If Not Right(daxie, 1) = "整" Then daxie = Replace(daxie, "拾元", "拾元零")
End Function。

相关文档
最新文档