自己写的简单的人民币大写转换代码

18627238500

1. Attribute VB_Name = "人民币大写"
   
2. Sub 人民币大写()
   
3. '
   
4. ' 人民币大写 宏
   
5. '
   
6. '
   
7.     Dim tb
   
8.     Dim s, s1, s2, s3
   
9.     Dim i, k, l, n
   
10.    
    
11.    
    
12.     s = "壹贰叁肆伍陆柒捌玖零"
    
13.     s1 = "亿仟佰拾万仟佰拾元角分"
    
14.    
    
15.     Set tb = Documents(1).Tables(1)
    
16.    
    
17.     s2 = Replace(tb.Cell(1, 1), Chr(13) & Chr(7), "")
    
18.    
    
19. s2 = s2 * 100
    
20.    
    
21.     l = Len(s2)
    
22.     k = Len(s1)
    
23.    
    
24.     For i = 1 To l
    
25.         n = Mid(s2, i, 1)
    
26.         If n = 0 Then n = 10
    
27.         'k = l
    
28.         s3 = s3 & Mid(s, n, 1) & Mid(s1, 11 - l + i, 1)
    
29.         'k = k - 1
    
30.     Next
    
31.    
    
32.     s3 = Replace(s3, "零万", "万")
    
33.     s3 = Replace(s3, "零仟", "零")
    
34.     s3 = Replace(s3, "零佰", "零")
    
35.     s3 = Replace(s3, "零拾", "零")
    
36.     s3 = Replace(s3, "零元", "元")
    
37.     s3 = Replace(s3, "零角", "零")
    
38.     s3 = Replace(s3, "零分", "")
    
39.    
    
40.     s3 = Replace(s3, "零零零万", "零")
    
41.     s3 = Replace(s3, "零零万", "万")
    
42.     s3 = Replace(s3, "零万", "万")
    
43.     s3 = Replace(s3, "零零零零零", "零")
    
44.     s3 = Replace(s3, "零零零零", "零")
    
45.     s3 = Replace(s3, "零零零", "零")
    
46.     s3 = Replace(s3, "零零", "零")
    
47.     s3 = Replace(s3, "零元", "元")
    
48.    
    
49.     If Right(s3, 2) = "元零" Then
    
50.         s3 = Replace(s3, "元零", "元整")
    
51.     End If
    
52.     tb.Cell(1, 3) = "人民币大写：" & s3
    
53.    
    
54.     Set tb = Nothing
    
55.    
    
56. End Sub
    

复制代码

自己试了下，能转换亿以内的数据，没添加数据检测，没有数据查找。

ming0018

原创的必须支持一下