设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 5960|回复: 14
打印 上一主题 下一主题

[其它] [原创]数字金额转换成中文大写金额的函数

[复制链接]
跳转到指定楼层
1#
发表于 2005-11-27 21:19:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
上传一个数字金额转换成中文大写金额的函数

Public Function MoneyConv(Money As Currency) As String
On Error GoTo Doerr

    Dim CN(9) As String
    Dim CU(15) As String
    Dim Temp As String, strNum As String
    Dim CM As String
    Dim tFirst As String, tEnd As String
    Dim i As Long, j As Long, k As Long   
    CN(0) = "零"
    CN(1) = "壹"
    CN(2) = "贰"
    CN(3) = "叁"
    CN(4) = "肆"
    CN(5) = "伍"
    CN(6) = "陆"
    CN(7) = "柒"
    CN(8) = "捌"
    CN(9) = "玖"
   
'    CU(0) = "分"
'    CU(1) = "角"
    CU(0) = "圆"
    CU(1) = "十"
    CU(2) = "佰"
    CU(3) = "仟"
    CU(4) = "万"
    CU(5) = "十"
    CU(6) = "佰"
    CU(7) = "仟"
    CU(8) = "亿"
    CU(9) = "十"
    CU(10) = "佰"
    CU(11) = "仟"
   
    If Money = 0 Then
        CM = "零圆整"
        GoTo Complete
    End If
    strNum = Trim(str(FormatCurrency(Money, 2, vbTrue, vbFalse, vbFalse)))   
    If Left(strNum, 1) = "-" Then
        tFirst = "负"
        strNum = Right(strNum, Len(strNum) - 1)
    Else
        tFirst = ""
    End If
   
    i = InStrRev(strNum, ".")
    If i <> 0 Then
        Temp = Right(strNum, i)
        If Len(strNum) - i = 1 Then Temp = Temp + "0"
        CM = CN(CInt(Left(Right(Temp, 2), 1))) + "角" + CN(CInt(Right(Temp, 1))) + "分"
        tEnd = ""
        strNum = Left(strNum, i - 1)
    Else
        tEnd = "整"
    End If
   
    i = 0
    For j = Len(strNum) To 1 Step -1
        k = CInt(Right(Left(strNum, j), 1))
        If k = 0 Then
            If i <> 0 And i <> 4 And i <> 8 Then
                CM = CN(k) + CM
            Else
                CM = CN(k) + CU(i) + CM
            End If
        Else
            CM = CN(k) + CU(i) + CM
        End If
'        CM = CN(k) + CU(i) + CM
        i = i + 1
    Next j
   
    CM = tFirst + CM + tEnd
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "亿零万零圆", "亿圆")
    CM = Replace(CM, "亿零万", "亿零")
    CM = Replace(CM, "万零圆", "万圆")
    CM = Replace(CM, "零亿", "亿")
    CM = Replace(CM, "零万", "万")
    CM = Replace(CM, "零圆", "圆")
    CM = Replace(CM, "零零", "零")
    CM = Replace(CM, "零零", "零")        '重复替换一次

Complete:
    Gerr = 0              '操作成功,无错误发生
    MoneyConv = CM
    Exit Function   
Doerr:
    Gerr = -1              '未知错误
Errexit:
    MoneyConv = ""
End Function[em07][em07]
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏1 分享分享 分享淘帖 订阅订阅
2#
发表于 2006-11-11 07:11:00 | 只看该作者
可是,我是菜鸟,实在不知道怎么一步步操作那?
3#
发表于 2006-11-11 07:13:00 | 只看该作者
希望大侠能详细指导一下怎么操作,谢谢啊!
4#
发表于 2006-11-11 21:50:00 | 只看该作者
做一个示例出来就好了
5#
发表于 2006-11-11 22:00:00 | 只看该作者
例子在这里,里面有两个不同的函数,效果也不一样

楼主的是第二个例子

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
6#
发表于 2006-11-12 04:30:00 | 只看该作者
觉得这两个函数做得不完美,

10.1元时,得出的是壹拾元壹角零分,最好不要体现零分,只要壹拾元壹角整就成
7#
发表于 2006-11-25 21:45:00 | 只看该作者
电风扇电风扇电风扇
8#
发表于 2007-7-14 17:05:00 | 只看该作者
555
9#
发表于 2007-7-17 18:26:00 | 只看该作者
仅供参考

Public Function URmb(ByVal Money As Currency) As String
'一个简单的小写金额转中文的函数

'作者: 海狸先生

Dim i As Integer, strMoney As String
   
   strMoney = StrReverse(Format(Money, "#.##") * 100)
   
   If Len(strMoney) > 14 Then MsgBox "超出范围!": Exit Function

   For i = 1 To Len(strMoney)
      URmb = Mid$("零壹贰叁肆伍陆柒捌玖", Mid$(strMoney, i, 1) + 1, 1) & Mid$("分角元拾佰仟万拾佰仟亿拾佰仟", i, 1) & URmb
   Next

End Function
10#
发表于 2007-7-17 18:43:00 | 只看该作者



搜索一下例子有好多

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-13 14:42 , Processed in 0.100462 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表