哪位朋友有符合银行金额大写规范的函数模块啊？

sxgaobo

规范如图

admin

http://www.office-cn.net/forum.php?mod=viewthread&tid=50605 可参考这个帖子

sxgaobo

很好的，可不太符合银行的规范啊！

todaynew

sxgaobo 发表于 2013-2-21 11:40
很好的，可不太符合银行的规范啊！

Function RMB(ByVal Numeral As Double) As String
     Dim Num As Double, str As String
     Dim match_str As String
     Dim i As Long
     
    Num = Round(Abs(Numeral), 2) '取绝对值四舍五入保留2位小数
     Select Case Num
         Case 0
             RMB = ""
         Case Is > 999999999999.99
             RMB = "不能大于12位数"
         Case Else
             str = Format(Num, "000000000000.00") '格式化字符串
            
             match_str = "^(\d{4})(\d{4})(\d{4}).(\d)(\d)$"
             str = ReplacMatch(str, match_str, "$1亿$2万$3元$4角$5分")
            
             match_str = "(\d)(\d)(\d)(\d)"
             str = ReplacMatch(str, match_str, "$1仟$2佰$3拾$4")
            
             match_str = "(0(仟|佰|拾))*0(亿|万|元)"
             str = ReplacMatch(str, match_str, "$30") '去中间0
            
             match_str = "(0(仟|佰|拾))+"
             str = ReplacMatch(str, match_str, "0") '去中间0
            
             match_str = "(亿|万|元)0+(\d)"
             str = ReplacMatch(str, match_str, "$10$2") '去中间0
            
             match_str = "(元)0(\d)"
             str = ReplacMatch(str, match_str, "$1$2") '去中间0
            
             match_str = "0(亿|万)"
             str = ReplacMatch(str, match_str, "") '去中间0
            
             match_str = "0元"
             str = ReplacMatch(str, match_str, "元") '去中间0
            
             match_str = "^0(\d)"
             str = ReplacMatch(str, match_str, "$1") '去中间0
            
             match_str = "^((0\W)+|\W0+)"
             str = ReplacMatch(str, match_str, "") '掐头
            
             match_str = "^((0\W)+|\W0+)"
             str = ReplacMatch(str, "(元)(0\W)+$", "$1") '去尾
            
             match_str = "(元)$"
             str = ReplacMatch(str, match_str, "$1整")
            
             str = Replace(Replace(Replace(Replace(Replace(str, "0", "零"), "1", "壹"), "2", "贰"), "3", "叁"), "4", "肆")
             str = Replace(Replace(Replace(Replace(Replace(str, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
             RMB = str
     End Select
End Function

Function ReplacMatch(ByVal str As String, ByVal match_str As String, ByVal Rematch_str As String) As String
    '引用：Microsoft VBScript Regular Expressions 5.5
    '功能：替换字符串
    '参数：Test_str--测试字符串，match_str--源正则表达式,Rematch_str--替换的正则表达式
    Dim re As New regexp
    re.Pattern = match_str
    re.IgnoreCase = True
    re.Global = True
    ReplacMatch = re.Replace(str, Rematch_str)
    Set re = Nothing
End Function

sxgaobo

谢谢版主！很简练精辟啊，看不懂啊！
可是还是有些不太符合啊！如￥325.04，应写成人民币叁佰贰拾伍元零肆分 不是 叁佰贰拾伍元零角肆分.10000应写成人民币壹万元整 不是 壹万元，少个整字啊

asklove

论坛上搜索“金额分栏显示及金额大写”，这个肯定符合你的要求

sxgaobo

谢谢了！我在版主给的代码的基础上修改了下，已经OK了，谢谢各位了！！！

smilingkiss

todaynew 发表于 2013-2-23 15:10
Function RMB(ByVal Numeral As Double) As String
    Dim Num As Double, str As String
    Dim mat ...

学习来了

smilingkiss

todaynew 发表于 2013-2-23 15:10
Function RMB(ByVal Numeral As Double) As String
    Dim Num As Double, str As String
    Dim mat ...

TestStr函数在哪里调用了？我好像没找到调用的地方

ycxchen

sxgaobo 发表于 2013-2-26 09:13
谢谢了！我在版主给的代码的基础上修改了下，已经OK了，谢谢各位了！！！

将修改后的代码、例子传上来供大家学习如何？