求一算法：数字金额用大写中文表示

feilai 2005-12-22 03:06:15
把金额的数字表示方式转化成大写中文表示，如：12035 转成 壹万贰仟零叁拾伍元,用vb写一算法
...全文
484 12 打赏 收藏 转发到动态 举报
写回复
用AI写文章
12 条回复
切换为时间正序
请发表友善的回复…
发表回复
lexrenzjun 2005-12-23
  • 打赏
  • 举报
 回复
不过负数的算法是不对的
lexrenzjun 2005-12-23
  • 打赏
  • 举报
 回复
1.03=壹元零角叁分
这样显示应该是个Bug
1.03=壹元零叁分
feilai 2005-12-23
  • 打赏
  • 举报
 回复
谢谢各位，我都会试试
胡楮智 2005-12-23
  • 打赏
  • 举报
 回复
这个是偶给华润啤酒公司销售系统写的，欢迎指教。
Option Explicit
Option Compare Text
DefInt I: DefStr S: DefDbl D: DefLng L: DefBool B

'*********************************************************************************************
'名称 fun_change
'作者　　 Morn Woo 于 1998.7.2
'功能 将双精度金额转换为汉字金额
'参数 MONEY 待转换的数字金额
'返回 汉字金额
'注意 本函数处理的最大金额不大于百亿
'*********************************************************************************************
Function Fun_Change(MONEY As Double) As String
Dim sDir '数据的正负
Dim smoney
Dim sReturn
Dim aUnit As Variant
Dim cleft As Currency '保存数据的小数部分
Dim i As Long '循环变量
Dim j As Long '保存数据的整数部分的位数
Dim number As Integer '临时保存单个的数
Dim iint As Long '保存数据的整数部分
If MONEY = 0 Then
Fun_Change = " "
Exit Function
End If
If MONEY < 0 Then sDir = "负" Else sDir = ""
MONEY = Abs(MONEY)
If MONEY > 999999999# Then Exit Function
aUnit = Array("拾亿", "亿", "仟万", "佰万", "拾万", "万", "仟", "佰", "拾")
'先处理数据的整数部分
'1 取数据的整数部分,并转换为字符型
iint = Fix(MONEY)
smoney = Trim(CStr(Fix(MONEY)))
j = Len(smoney)
'2 利用循环进行数据转换
For i = 1 To j
number = CInt(Mid(smoney, i, 1))
If i = 1 Then
If number <> 0 Then
If j = 1 Then
sReturn = Fun_Changeb(number)
Else
sReturn = Fun_Changeb(number) & aUnit(9 - j + i)
End If
End If
Else
If number <> 0 Then
If j = i Then
sReturn = sReturn & Fun_Changeb(number)
Else
sReturn = sReturn & Fun_Changeb(number) & _
aUnit(9 - j + i)
End If
Else
If i = j - 2 Then sReturn = sReturn & "零"
If i = j - 1 Then
If Right(sReturn, 1) <> "零" Then
sReturn = sReturn & "零"
End If
End If
If i = j And Right(sReturn, 1) = "零" Then
sReturn = Left(sReturn, Len(sReturn) - 1)
End If
End If
End If
Next i
'处理数据的小数部分
'1 从数据中取出小数部分
cleft = (CCur(CLng(CCur(MONEY - iint) * 100)) / 100)
'判断有无小数部分
If cleft = 0 Then
sReturn = sReturn & "圆整"
Else
'转换小数点后的数据
cleft = cleft * 100
If cleft < 10 Then
sReturn = sReturn & "圆" & Fun_Changeb(CLng(cleft)) & "分"
Else
number = CInt(Mid(CStr(cleft), 1, 1))
sReturn = sReturn & "圆" & Fun_Changeb(number) & "角"
If cleft <> CCur(number) Then
number = CInt(Mid(CStr(cleft), 2, 1))
If number <> 0 Then
sReturn = sReturn & Fun_Changeb(number) & "分"
End If
End If
End If
End If
'最后的处理
'1 如果壹拾在首将壹拾用拾替换
'If InStr(sreturn, "壹拾") = 1 Then
' sreturn = Right(sreturn, Len(sreturn) - 1)
'End If
'2 删除重复的"万"
i = InStr(sReturn, "万")
Do While i <> 0
smoney = sReturn
Fun_Change = sReturn
sReturn = Left(sReturn, i - 1) & Right(sReturn, Len(sReturn) - i)
i = InStr(sReturn, "万")
If i = 0 Then
sReturn = Fun_Change
End If
Loop
' sreturn = smoney
'2 删除重复的"亿"
i = InStr(sReturn, "亿")
If i <> 0 Then
smoney = sReturn
sReturn = Left(sReturn, i - 1) & Right(sReturn, Len(sReturn) - i)
If InStr(sReturn, "亿") = 0 Then sReturn = smoney
End If
Fun_Change = sDir & "『" & sReturn & "』"
End Function

'*********************************************************************************************
'名称 fun_changeb
'作者　　 Morn Woo 于 1998.7.2
'功能 将整型数字转换为大写汉字数字
'参数 i,待转换的数字
'返回 汉字金额
'*********************************************************************************************
Function Fun_Changeb(i As Integer) As String
Select Case i
Case 0
Fun_Changeb = "零 "
Case 1
Fun_Changeb = "壹"
Case 2
Fun_Changeb = "贰"
Case 3
Fun_Changeb = "叁"
Case 4
Fun_Changeb = "肆"
Case 5
Fun_Changeb = "伍"
Case 6
Fun_Changeb = "陆"
Case 7
Fun_Changeb = "柒"
Case 8
Fun_Changeb = "捌"
Case 9
Fun_Changeb = "玖"
End Select
End Function

'*********************************************************************************************
'名称 Fun_Changea
'作者　　 Morn Woo 于 1998.7.2
'功能 将整型数字转换为汉字数字
'参数 i,待转换的数字
'返回 汉字金额
'*********************************************************************************************
Function Fun_Changea(i As Integer) As String
Select Case i
Case 0
Fun_Changea = "０"
Case 1
Fun_Changea = "一"
Case 2
Fun_Changea = "二"
Case 3
Fun_Changea = "三"
Case 4
Fun_Changea = "四"
Case 5
Fun_Changea = "五"
Case 6
Fun_Changea = "六"
Case 7
Fun_Changea = "七"
Case 8
Fun_Changea = "八"
Case 9
Fun_Changea = "九"
End Select
End Function
northwolves 2005-12-22
  • 打赏
  • 举报
 回复
Debug.Print daxie("0.000") '整！！！

呵呵，早期习作，漏洞百出。

希望大家把漏洞发到这里，一并完善，谢谢：

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

northwolves 2005-12-22
  • 打赏
  • 举报
 回复
谢谢大家使用我的代码，但有个BUG，一直没改

Debug.Print daxie("100000020") 返回 壹億萬零贰拾圆整


加一句就好了：

Function daxie(money As String) As String '
Dim x As String, y As String, i As Long
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 = Replace(y, "yw", "y") '------------------------------------------->add here
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

大家看看还有没有别的BUG。

boydgmx 2005-12-22
  • 打赏
  • 举报
 回复
to faysky2() :

Debug.Print daxie("0.000") '整！！！

还是不完美
feilai 2005-12-22
  • 打赏
  • 举报
 回复
To : faysky2 ,算法不行，转出的数据有不对的
feilai 2005-12-22
  • 打赏
  • 举报
 回复
谢谢
zou19820704 2005-12-22
  • 打赏
  • 举报
 回复
楼上的兄弟好快呀，我也有这个意思要贴你的代码！！呵呵
faysky2 2005-12-22
  • 打赏
  • 举报
 回复
别人写的一个：

Function daxie(money As String) As String '
Dim x As String, y As String, i As Long
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 Command1_Click()
Debug.Print daxie("1234562.3238") ' return: 陆仟贰佰壹拾捌萬贰仟壹佰贰拾贰億壹仟贰佰叁拾萬玖仟叁佰贰拾贰圆叁角贰分
End Sub
truewill 2005-12-22
  • 打赏
  • 举报
 回复
http://www.chinaitpower.com/A/2001-11-01/3542.html
最简单算法：将数字转换为符合使用习惯的大写金额
最简单算法：将数字转换为符合使用习惯的大写金额 编写语言：java 输出结果： 1200.00 壹仟贰佰元 1200.10 壹仟贰佰元壹角 1234.05 壹仟贰佰叁拾肆元零伍分 1200.05 壹仟贰佰元零伍分 1004.05 壹仟零肆元零伍分 10004.05 壹万零肆元零伍分 100004.05 壹拾万零肆元零伍分 1000004.05 壹佰万零肆元零伍分 123456789012345.05 壹佰贰拾叁万肆仟伍佰陆拾柒亿捌仟玖佰零壹万贰仟叁佰肆拾伍元零伍分 如对以上有问题请在此留言
数字 转 金额 最快算法
数字转中文大写金额的程序,是我所知道的最快算法.
隐马尔科夫算法：中文分词神器
本课程首先以一个简单的应用案例介绍了隐马尔科夫算法和隐马尔科夫能解决的三类问题，并构造隐马尔科夫五元组。 由此引出了隐马尔科夫分词算法，并以分词实际应用为例，介绍了隐马尔科夫分词算法的整个逻辑包括参数...
数字金额转换成大写金额
本代码示例了如何将一个整数型数字转换为中文大写金额的算法。
人民币大写金额转数字源码
网上很多数字金额转人民币大写的代码也很好用,但是一直没有看到中文大写金额转数字的算法,这个是我自己敲的,也运行了单元测试,应该可用的,大家拿起看看吧,有问题欢迎留言!
资源

1,066

社区成员

6,496

社区内容

发帖
与我相关
我的任务
社区描述
VB 资源
社区管理员
  • 资源
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章