Office中国论坛/Access中国论坛

标题: 哪位朋友有符合银行金额大写规范的函数模块啊？ [打印本页]
作者: sxgaobo    时间: 2013-2-20 18:31
标题: 哪位朋友有符合银行金额大写规范的函数模块啊？
本帖最后由 sxgaobo 于 2013-2-20 22:23 编辑

规范如图
作者: admin    时间: 2013-2-21 09:37
http://www.office-cn.net/forum.php?mod=viewthread&tid=50605 可参考这个帖子
作者: sxgaobo    时间: 2013-2-21 11:40
很好的，可不太符合银行的规范啊！
作者: todaynew    时间: 2013-2-23 15:10
本帖最后由 todaynew 于 2013-2-26 14:07 编辑
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    时间: 2013-2-24 18:14
谢谢版主！很简练精辟啊，看不懂啊！
可是还是有些不太符合啊！如￥325.04，应写成人民币叁佰贰拾伍元零肆分 不是 叁佰贰拾伍元零角肆分.10000应写成人民币壹万元整 不是 壹万元，少个整字啊
作者: asklove    时间: 2013-2-26 09:04
论坛上搜索“金额分栏显示及金额大写”，这个肯定符合你的要求
作者: sxgaobo    时间: 2013-2-26 09:13
谢谢了！我在版主给的代码的基础上修改了下，已经OK了，谢谢各位了！！！
作者: smilingkiss    时间: 2013-2-26 09:19
todaynew 发表于 2013-2-23 15:10
Function RMB(ByVal Numeral As Double) As String
    Dim Num As Double, str As String
    Dim mat ...

学习来了
作者: smilingkiss    时间: 2013-2-26 09:21
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    时间: 2013-2-26 10:41
sxgaobo 发表于 2013-2-26 09:13
谢谢了！我在版主给的代码的基础上修改了下，已经OK了，谢谢各位了！！！

将修改后的代码、例子传上来供大家学习如何？
作者: 轻风    时间: 2013-2-26 11:07
我一直用这个：
  1. ' 名称： CCh
  2. '        得到一位数字 N1 的汉字大写
  3. '        0 返回 ""
  4. Private Function cch(n1) As String
  5.     Select Case n1
  6.     Case 0:        cch = "零"
  7.     Case 1:        cch = "壹"
  8.     Case 2:        cch = "贰"
  9.     Case 3:        cch = "叁"
  10.     Case 4:        cch = "肆"
  11.     Case 5:        cch = "伍"
  12.     Case 6:        cch = "陆"
  13.     Case 7:        cch = "柒"
  14.     Case 8:        cch = "捌"
  15.     Case 9:        cch = "玖"
  16.     End Select
  17. End Function


  20. '名称： ChMoney
  21. '       得到数字 N1 的汉字大写
  22. '       最大为 千亿
  23. '       O 返回 ""
  24. Public Function ChMoney(n1) As String
  25.     Dim tMoney As String
  26.     Dim lMoney As String
  27.     Dim tn    '小数位置
  28.     Dim s1 As String    '临时STRING 小数部分
  29.     Dim s2 As String    '1000 以内
  30.     Dim s3 As String    '10000
  31.     Dim s4 As String
  32.      Dim s5 As String
  33.     Dim S As String



  37.     If n1 = 0 Then
  38.         ChMoney = " "
  39.         Exit Function
  40.     End If
  41.     If n1 < 0 Then
  42.         ChMoney = "负" + ChMoney(Abs(n1))
  43.         Exit Function
  44.     End If
  45.     tMoney = Trim(Str(n1))

  47.     tn = InStr(tMoney, ".")  '小数位置
  48.     s1 = ""
  49.     If tn = 0 Then    '角分为零，
  50.         s1 = "整"
  51.     End If

  53.     If tn <> 0 Then
  54.         ST1 = Right(tMoney, Len(tMoney) - tn)    '小数
  55.         If ST1 <> "" Then
  56.             T1 = Left(ST1, 1)
  57.             ST1 = Right(ST1, Len(ST1) - 1)
  58.             If T1 <> "0" And ST1 <> "" Then
  59.                 s1 = s1 + cch(Val(T1)) + "角"
  60.             End If
  61.             If T1 <> "0" And ST1 = "" Then    '角位不为零，分位为零
  62.                 s1 = s1 + cch(Val(T1)) + "角整"
  63.             End If

  65.             If T1 = "0" And ST1 <> "" Then    '角位为零时
  66.                 s1 = s1 + cch(Val(T1))
  67.             End If

  69.             If ST1 <> "" Then
  70.                 T1 = Left(ST1, 1)
  71.                 s1 = s1 + cch(Val(T1)) + "分"
  72.             End If
  73.         End If
  74. '=============================================================================
  75.             '以上是小数的转换

  77.         ST1 = Left(tMoney, tn - 1)
  78.     Else
  79.         ST1 = tMoney
  80.     End If


  83.     s2 = ""
  84.     If ST1 <> "" Then
  85.         T1 = Right(ST1, 1)
  86.         ST1 = Left(ST1, Len(ST1) - 1)
  87.         s2 = cch(Val(T1)) + s2
  88.     End If
  89. '元
  90.     If ST1 <> "" Then
  91.         T1 = Right(ST1, 1)
  92.         ST1 = Left(ST1, Len(ST1) - 1)
  93.         If T1 <> "0" Then
  94.             s2 = cch(Val(T1)) + "拾" + s2
  95.         Else
  96.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  97.         End If
  98.     End If
  99. '十
  100.     If ST1 <> "" Then
  101.         T1 = Right(ST1, 1)
  102.         ST1 = Left(ST1, Len(ST1) - 1)
  103.         If T1 <> "0" Then
  104.             s2 = cch(Val(T1)) + "佰" + s2
  105.         Else
  106.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  107.         End If
  108.     End If
  109. '百
  110.     If ST1 <> "" Then
  111.         T1 = Right(ST1, 1)
  112.         ST1 = Left(ST1, Len(ST1) - 1)
  113.         If T1 <> "0" Then
  114.             s2 = cch(Val(T1)) + "仟" + s2
  115.         Else
  116.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  117.         End If
  118.     End If
  119. '千
  120. '============================================================================
  121.     s3 = ""
  122.     If ST1 <> "" Then
  123.         T1 = Right(ST1, 1)
  124.         ST1 = Left(ST1, Len(ST1) - 1)
  125.         s3 = cch(Val(T1)) + s3
  126.     End If

  128. '万
  129.     If ST1 <> "" Then
  130.         T1 = Right(ST1, 1)
  131.         ST1 = Left(ST1, Len(ST1) - 1)
  132.         If T1 <> "0" Then
  133.             s3 = cch(Val(T1)) + "拾" + s3
  134.         Else
  135.             If Left(s3, 1) <> "零" Then s3 = "零" + s3
  136.         End If
  137.     End If
  138. '十万
  139.     If ST1 <> "" Then
  140.         T1 = Right(ST1, 1)
  141.         ST1 = Left(ST1, Len(ST1) - 1)
  142.         If T1 <> "0" Then
  143.             s3 = cch(Val(T1)) + "佰" + s3
  144.         Else
  145.             If Left(s3, 1) <> "零" Then s3 = "零" + s3
  146.         End If
  147.     End If
  148. '百万
  149.     If ST1 <> "" Then
  150.         T1 = Right(ST1, 1)
  151.         ST1 = Left(ST1, Len(ST1) - 1)
  152.         If T1 <> "0" Then
  153.             s3 = cch(Val(T1)) + "仟" + s3
  154.             Else
  155.               If Left(s3, 1) <> "零" Then s3 = "零" + s3
  156.         End If
  157.     End If
  158.    
  159. '千万
  160.   '======================================================================
  161.     s4 = ""
  162.     If ST1 <> "" Then
  163.         T1 = Right(ST1, 1)
  164.         ST1 = Left(ST1, Len(ST1) - 1)
  165.         s4 = cch(Val(T1)) + s4
  166.     End If

  168. '亿
  169.     If ST1 <> "" Then
  170.         T1 = Right(ST1, 1)
  171.         ST1 = Left(ST1, Len(ST1) - 1)
  172.         If T1 <> "0" Then
  173.             s4 = cch(Val(T1)) + "拾" + s4
  174.         Else
  175.             If Left(s4, 1) <> "零" Then s4 = "零" + s4
  176.         End If
  177.     End If
  178. '十亿
  179.     If ST1 <> "" Then
  180.         T1 = Right(ST1, 1)
  181.         ST1 = Left(ST1, Len(ST1) - 1)
  182.         If T1 <> "0" Then
  183.             s4 = cch(Val(T1)) + "佰" + s4
  184.         Else
  185.             If Left(s4, 1) <> "零" Then s4 = "零" + s4
  186.         End If
  187.     End If
  188. '百亿
  189.     If ST1 <> "" Then
  190.         T1 = Right(ST1, 1)
  191.         ST1 = Left(ST1, Len(ST1) - 1)
  192.         If T1 <> "0" Then
  193.             s4 = cch(Val(T1)) + "仟" + s4
  194.             Else
  195.               If Left(s4, 1) <> "零" Then s4 = "零" + s4
  196.         End If
  197.     End If
  198.    
  199.     '千亿
  200.    '==========================================================================
  201.    
  202.     If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
  203.    
  204.     If Len(s3) > 0 Then
  205.         If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  206.         If s3 <> "" Then s3 = s3 & "万"
  207.     End If

  209.     If Len(s4) > 0 Then
  210.         If Right(s4, 1) = "零" Then s4 = Left(s4, Len(s4) - 1)
  211.        If s4 <> "" Then s4 = s4 & "亿"
  212.     End If
  213. '====================================================
  214.   ChMoney = IIf(s4 & s3 & s2 = "", s1, s4 & s3 & s2 & "元" & s1)
  215.   

  217. End Function
复制代码
作者: todaynew    时间: 2013-2-26 11:31
sxgaobo 发表于 2013-2-26 09:13
谢谢了！我在版主给的代码的基础上修改了下，已经OK了，谢谢各位了！！！

For i = 1 To 14
      str = ReplacMatch(str, "^((0\W)|\W0)", "") '掐头
Next
For i = 1 To 2
      str = ReplacMatch(str, "(0\W)$", "") '去尾
Next

可改为：
str = ReplacMatch(str, "^(0\W)+", "") '掐头
str = ReplacMatch(str, "元(0\W)+$", "元") '去尾
作者: ycxchen    时间: 2013-2-26 12:17
轻风 发表于 2013-2-26 11:07
我一直用这个：

谢谢分享！
作者: sxgaobo    时间: 2013-2-26 17:24
ycxchen 发表于 2013-2-26 10:41
将修改后的代码、例子传上来供大家学习如何？

版主的代码看不太懂，只是修改了下后面，满足了自己的需求！
            str = Replace(Replace(Replace(Replace(Replace(str, "0", "零"), "1", "壹"), "2", "贰"), "3", "叁"), "4", "肆")
            str = Replace(Replace(Replace(Replace(Replace(str, "5", "伍"), "6", "陆"), "7", "柒"), "8", "捌"), "9", "玖")
            str = Replace(str, "零角", "零")
            
          If Right(str, 1) = "元" Then
             RMB = str & "整"
          Else
             RMB = str
          End If
作者: ycxchen    时间: 2013-2-27 09:17
sxgaobo 发表于 2013-2-26 17:24
版主的代码看不太懂，只是修改了下后面，满足了自己的需求！
            str = Replace(Replace(Replac ...

学习了！



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3