金额转换成汉字,输出

Ge 2003-09-03 03:52:21
Public Function Chbig(sdata As String) As String
Dim leng As Integer
Dim stmp As String
Dim bdata As String
Dim s As String
Dim p, b As String
Dim s2 As String
Dim f As Boolean
Dim n, n1, c As Integer
Select Case Len(sdata)
Case 5
s = "万"
Case 4
s = "仟"
Case 3
s = "佰"
Case 2
s = "拾"
Case 1
s = ""
End Select

For n = 1 To Len(sdata)

For n1 = n To Len(sdata)
s2 = Mid(sdata, n1, 1)
If s2 <> "0" Then
GoTo nex
End If
Next n1
GoTo ex
nex:
stmp = Mid(sdata, n, 1)
Select Case stmp
Case "1"
bdata = "壹" & s
Case "2"
bdata = "贰" & s
Case "3"
bdata = "叁" & s
Case "4"
bdata = "肆" & s
Case "5"
bdata = "伍" & s
Case "6"
bdata = "陆" & s
Case "7"
bdata = "柒" & s
Case "8"
bdata = "捌" & s
Case "9"
bdata = "玖" & s
End Select

Select Case s
Case "万"
s = "仟"
Case "仟"
s = "佰"
Case "佰"
s = "拾"
Case "拾"
s = ""
End Select
If n > 1 And stmp = "0" Then
If p = "零" Then
bdata = ""
Else
p = "零"
bdata = "零"
End If
End If
s1 = s1 & bdata
next1:
Next n
ex:
Chbig = s1 & "元整"
End Function
...全文
51 3 打赏 收藏 举报
写回复
3 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
lisen101 2003-09-03

大小写金额转换函数

Function val_string(je As Double) As String

Dim c As String, g As String, h As String
Dim l As Integer, j As Integer, k As Integer
Dim e As String, q As Integer

c = "分角元拾佰仟万拾佰仟亿拾佰"
g = "零壹贰叁肆伍陆柒捌玖"
je = Abs(round(je, 2))
h = Trim(Str(je * 100))
l = Len(h)
j = 1
k = 0
e = ""
While j <= l
q = Val(Mid(h, j, 1))
If q <> 0 Then
If k = 1 Then
e = e + "零"
End If
e = e + Mid(g, q + 1, 1) + Mid(c, (l - j) + 1, 1)
k = 0
Else
Select Case l - j
Case 10
e = e + "亿"
k = 0
Case 6
If Len(e) > 3 Then
If Mid(e, Len(e) - 3, 1) = "拾" Or Mid(e, Len(e) - 3, 1) = "佰" Or Mid(e, Len(e) - 3, 1) = "仟" Then
If Not Mid(e, Len(e) - 2, 1) = "零" Then
e = Mid(e, 1, Len(e) - 2) + "零" + Mid(e, Len(e) - 1, 2)
End If
End If
End If
If Mid(e, Len(e), 1) <> "亿" Then
e = e + "万"
k = 0
End If
Case 4
If Len(e) > 3 Then
If Mid(e, Len(e) - 3, 1) = "拾" Or Mid(e, Len(e) - 3, 1) = "佰" Or Mid(e, Len(e) - 3, 1) = "仟" Then
If Not Mid(e, Len(e) - 2, 1) = "零" Then
e = Mid(e, 1, Len(e) - 2) + "零" + Mid(e, Len(e) - 1, 2)
End If
End If
End If
k = 1
Case 2
e = e + "元"
k = 0
Case Else
k = 1
End Select
End If
j = j + 1
Wend
e = e + "整"
val_string = e

End Function
==============================
不过楼主 太吝啬,嘿!
  • 打赏
  • 举报
回复
liaorui 2003-09-03
你这样做太麻烦了,如果需要,我可以给你做一个例子。
  • 打赏
  • 举报
回复
xayzmb 2003-09-03
没有考虚小数位
  • 打赏
  • 举报
回复
相关推荐
发帖
非技术类
加入

726

社区成员

VB 版八卦、闲侃,联络感情地盘,禁广告帖、作业帖
社区管理员
  • 非技术类社区
申请成为版主
帖子事件
创建了帖子
2003-09-03 03:52
社区公告
暂无公告