设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12
返回列表 发新帖
楼主: sxgaobo
打印 上一主题 下一主题

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

[复制链接]

点击这里给我发消息

11#
发表于 2013-2-26 11:07:31 | 只看该作者
我一直用这个:
  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


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



  32.     If n1 = 0 Then
  33.         ChMoney = " "
  34.         Exit Function
  35.     End If
  36.     If n1 < 0 Then
  37.         ChMoney = "负" + ChMoney(Abs(n1))
  38.         Exit Function
  39.     End If
  40.     tMoney = Trim(Str(n1))

  41.     tn = InStr(tMoney, ".")  '小数位置
  42.     s1 = ""
  43.     If tn = 0 Then    '角分为零,
  44.         s1 = "整"
  45.     End If

  46.     If tn <> 0 Then
  47.         ST1 = Right(tMoney, Len(tMoney) - tn)    '小数
  48.         If ST1 <> "" Then
  49.             T1 = Left(ST1, 1)
  50.             ST1 = Right(ST1, Len(ST1) - 1)
  51.             If T1 <> "0" And ST1 <> "" Then
  52.                 s1 = s1 + cch(Val(T1)) + "角"
  53.             End If
  54.             If T1 <> "0" And ST1 = "" Then    '角位不为零,分位为零
  55.                 s1 = s1 + cch(Val(T1)) + "角整"
  56.             End If

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

  60.             If ST1 <> "" Then
  61.                 T1 = Left(ST1, 1)
  62.                 s1 = s1 + cch(Val(T1)) + "分"
  63.             End If
  64.         End If
  65. '=============================================================================
  66.             '以上是小数的转换

  67.         ST1 = Left(tMoney, tn - 1)
  68.     Else
  69.         ST1 = tMoney
  70.     End If


  71.     s2 = ""
  72.     If ST1 <> "" Then
  73.         T1 = Right(ST1, 1)
  74.         ST1 = Left(ST1, Len(ST1) - 1)
  75.         s2 = cch(Val(T1)) + s2
  76.     End If
  77. '元
  78.     If ST1 <> "" Then
  79.         T1 = Right(ST1, 1)
  80.         ST1 = Left(ST1, Len(ST1) - 1)
  81.         If T1 <> "0" Then
  82.             s2 = cch(Val(T1)) + "拾" + s2
  83.         Else
  84.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  85.         End If
  86.     End If
  87. '十
  88.     If ST1 <> "" Then
  89.         T1 = Right(ST1, 1)
  90.         ST1 = Left(ST1, Len(ST1) - 1)
  91.         If T1 <> "0" Then
  92.             s2 = cch(Val(T1)) + "佰" + s2
  93.         Else
  94.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  95.         End If
  96.     End If
  97. '百
  98.     If ST1 <> "" Then
  99.         T1 = Right(ST1, 1)
  100.         ST1 = Left(ST1, Len(ST1) - 1)
  101.         If T1 <> "0" Then
  102.             s2 = cch(Val(T1)) + "仟" + s2
  103.         Else
  104.             If Left(s2, 1) <> "零" Then s2 = "零" + s2
  105.         End If
  106.     End If
  107. '千
  108. '============================================================================
  109.     s3 = ""
  110.     If ST1 <> "" Then
  111.         T1 = Right(ST1, 1)
  112.         ST1 = Left(ST1, Len(ST1) - 1)
  113.         s3 = cch(Val(T1)) + s3
  114.     End If

  115. '万
  116.     If ST1 <> "" Then
  117.         T1 = Right(ST1, 1)
  118.         ST1 = Left(ST1, Len(ST1) - 1)
  119.         If T1 <> "0" Then
  120.             s3 = cch(Val(T1)) + "拾" + s3
  121.         Else
  122.             If Left(s3, 1) <> "零" Then s3 = "零" + s3
  123.         End If
  124.     End If
  125. '十万
  126.     If ST1 <> "" Then
  127.         T1 = Right(ST1, 1)
  128.         ST1 = Left(ST1, Len(ST1) - 1)
  129.         If T1 <> "0" Then
  130.             s3 = cch(Val(T1)) + "佰" + s3
  131.         Else
  132.             If Left(s3, 1) <> "零" Then s3 = "零" + s3
  133.         End If
  134.     End If
  135. '百万
  136.     If ST1 <> "" Then
  137.         T1 = Right(ST1, 1)
  138.         ST1 = Left(ST1, Len(ST1) - 1)
  139.         If T1 <> "0" Then
  140.             s3 = cch(Val(T1)) + "仟" + s3
  141.             Else
  142.               If Left(s3, 1) <> "零" Then s3 = "零" + s3
  143.         End If
  144.     End If
  145.    
  146. '千万
  147.   '======================================================================
  148.     s4 = ""
  149.     If ST1 <> "" Then
  150.         T1 = Right(ST1, 1)
  151.         ST1 = Left(ST1, Len(ST1) - 1)
  152.         s4 = cch(Val(T1)) + s4
  153.     End If

  154. '亿
  155.     If ST1 <> "" Then
  156.         T1 = Right(ST1, 1)
  157.         ST1 = Left(ST1, Len(ST1) - 1)
  158.         If T1 <> "0" Then
  159.             s4 = cch(Val(T1)) + "拾" + s4
  160.         Else
  161.             If Left(s4, 1) <> "零" Then s4 = "零" + s4
  162.         End If
  163.     End If
  164. '十亿
  165.     If ST1 <> "" Then
  166.         T1 = Right(ST1, 1)
  167.         ST1 = Left(ST1, Len(ST1) - 1)
  168.         If T1 <> "0" Then
  169.             s4 = cch(Val(T1)) + "佰" + s4
  170.         Else
  171.             If Left(s4, 1) <> "零" Then s4 = "零" + s4
  172.         End If
  173.     End If
  174. '百亿
  175.     If ST1 <> "" Then
  176.         T1 = Right(ST1, 1)
  177.         ST1 = Left(ST1, Len(ST1) - 1)
  178.         If T1 <> "0" Then
  179.             s4 = cch(Val(T1)) + "仟" + s4
  180.             Else
  181.               If Left(s4, 1) <> "零" Then s4 = "零" + s4
  182.         End If
  183.     End If
  184.    
  185.     '千亿
  186.    '==========================================================================
  187.    
  188.     If Right(s2, 1) = "零" Then s2 = Left(s2, Len(s2) - 1)
  189.    
  190.     If Len(s3) > 0 Then
  191.         If Right(s3, 1) = "零" Then s3 = Left(s3, Len(s3) - 1)
  192.         If s3 <> "" Then s3 = s3 & "万"
  193.     End If

  194.     If Len(s4) > 0 Then
  195.         If Right(s4, 1) = "零" Then s4 = Left(s4, Len(s4) - 1)
  196.        If s4 <> "" Then s4 = s4 & "亿"
  197.     End If
  198. '====================================================
  199.   ChMoney = IIf(s4 & s3 & s2 = "", s1, s4 & s3 & s2 & "元" & s1)
  200.   

  201. End Function
复制代码
12#
发表于 2013-2-26 11:31:51 | 只看该作者
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)+$", "元") '去尾
13#
发表于 2013-2-26 12:17:02 | 只看该作者
轻风 发表于 2013-2-26 11:07
我一直用这个:

谢谢分享!
14#
 楼主| 发表于 2013-2-26 17:24:40 | 只看该作者
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
15#
发表于 2013-2-27 09:17:17 | 只看该作者
sxgaobo 发表于 2013-2-26 17:24
版主的代码看不太懂,只是修改了下后面,满足了自己的需求!
            str = Replace(Replace(Replac ...

学习了!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-6-2 00:07 , Processed in 0.078633 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

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