求救,关于转换金额大写的问题.

lujianyu1189 2004-08-13 06:51:58
以下代码可以转换数字成金额大写,但在转换30.34类似的金额时,只难转换成"叁拾元叁角肆分",而我要转换成"叁拾元零叁角肆分",即元位为"0"时,元和角之间要加"零",我不知道在哪里修改代码,请各位帮忙/代码如下:
-------------------窗体控件布局如下----------------------------------
一个TEXT1(用来输入要转换在金额)
一个TEXT2(用来显示转换后的大写金额)
一个COMMAND1按钮,运行转换命令

--------------------按钮代码------------------
Private Sub Command1_Click()
Text2 = ChMoney(Val(Text1))
End Sub

-------------------模块代码(cmoney.bas)-------------
' 名称: CCh
' 得到一位数字 N1 的汉字大写
' 0 返回 ""
Private Function CCh(N1) As String
Select Case N1
Case 0
CCh = "零"
Case 1
CCh = "壹"
Case 2
CCh = "贰"
Case 3
CCh = "叁"
Case 4
CCh = "肆"
Case 5
CCh = "伍"
Case 6
CCh = "陆"
Case 7
CCh = "柒"
Case 8
CCh = "捌"
Case 9
CCh = "玖"
End Select
End Function


'名称: ChMoney
' 得到数字 N1 的汉字大写
' 最大为 千万位
' O 返回 ""
Public Function ChMoney(N1) As String
Dim tMoney As String
Dim lMoney As String
Dim tn '小数位置
Dim s1 As String '临时STRING 小数部分
Dim s2 As String '1000 以内
Dim s3 As String '10000



If N1 = 0 Then
ChMoney = " "
Exit Function
End If
If N1 < 0 Then
ChMoney = "负" + ChMoney(Abs(N1))
Exit Function
End If
tMoney = Trim(Str(N1))
tn = InStr(tMoney, ".") '小数位置
s1 = ""

If tn <> 0 Then
ST1 = Right(tMoney, Len(tMoney) - tn)
If ST1 <> "" Then
t1 = Left(ST1, 1)
ST1 = Right(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s1 = s1 + CCh(Val(t1)) + "角"
End If
If ST1 <> "" Then
t1 = Left(ST1, 1)
s1 = s1 + CCh(Val(t1)) + "分"
End If
End If
ST1 = Left(tMoney, tn - 1)
Else
ST1 = tMoney
End If


s2 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(t1)) + s2
End If

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "佰" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "仟" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

s3 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s3 = CCh(Val(t1)) + s3
End If


If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "拾" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "佰" + s3
Else
If Left(s3, 1) <> "零" Then s3 = "零" + s3
End If
End If

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s3 = CCh(Val(t1)) + "仟" + s3
End If
End If
If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
If Len(s3) > 0 Then
If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
s3 = s3 & "万"
End If

ChMoney = IIf(s3 & s2 = "", s1, s3 & s2 & "元" & s1)

End Function

...全文
353 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
northwolves 2004-08-13
  • 打赏
  • 举报
回复
个人认为你们银行的要求不当,加零画蛇添足。
northwolves 2004-08-13
  • 打赏
  • 举报
回复
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 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 = sign & y
If Not Right(daxie, 1) = "整" Then daxie = Replace(daxie, "拾圆", "拾圆零")


End Function

Private Sub Command1_Click()
Debug.Print daxie("-6208212212309320.27") ' return: 负陆仟贰佰零捌萬贰仟壹佰贰拾贰億壹仟贰佰叁拾萬玖仟叁佰贰拾圆零贰角柒分
End Sub
lujianyu1189 2004-08-13
  • 打赏
  • 举报
回复
如果是负数呢,好像你的代码中没有处理负数哟。
lujianyu1189 2004-08-13
  • 打赏
  • 举报
回复
to 狼行天下:
如果你的代码里要实现我的要求,该怎么办呢?要修改哪个地方呢?请指点
clark_rain 2004-08-13
  • 打赏
  • 举报
回复
s2 = ""
If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
s2 = CCh(Val(t1)) + s2
End If

'添加两行代码
if t1="0" then s1="零" & s1
if s1="零" then s1=""

If ST1 <> "" Then
t1 = Right(ST1, 1)
ST1 = Left(ST1, Len(ST1) - 1)
If t1 <> "0" Then
s2 = CCh(Val(t1)) + "拾" + s2
Else
If Left(s2, 1) <> "零" Then s2 = "零" + s2
End If
End If

我现在没有vb,你自己试试吧!
northwolves 2004-08-13
  • 打赏
  • 举报
回复
我的代码:

http://blog.csdn.net/northwolves/archive/2004/05/30/19599.aspx
northwolves 2004-08-13
  • 打赏
  • 举报
回复
函数最后加一句:
chmoney = Replace(chmoney, "拾元", "拾元零")
lujianyu1189 2004-08-13
  • 打赏
  • 举报
回复
但我们这边的银行要求,如果十位有0的话,在个位的前面要加零呀/如例:1320.12,则要写成壹千叁佰贰拾元零壹角贰分
Andy__Huang 2004-08-13
  • 打赏
  • 举报
回复
30.34 "叁拾元叁角肆分",已經正確了
"叁拾元零叁角肆分",你讀的是哪一個零?

你這樣做對了,這個零讀出來是錯誤的。

7,763

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧