[分享] 數字轉國字金額(可變成公式使用)

PKKO

各位大大好,此為小弟在網路上搜尋之後進行小改版,方便各位直接使用
重要說明:因為小弟的金額只用到佰萬元以內,因此此程式只適用於佰萬元以內,若要增加可自行修改
方式如下
一、插入模組
二、將此程式碼完整貼上
三、在公式的位置直接打上=Money(A1)
       就會直接出現國字金額了
若需要"元整",就直接修改VBA或是修改=Money(A1) &"元整"
若有錯誤還請各位提出,個人測試後使用無誤

1. Function Money(Mny As String) As String
   
2.     Dim w(10), z(10), r(10)
   
3.     word = Mny
   
4.     For i = 1 To Len(word)
   
5.         w(i) = Mid(word, i, 1)
   
6.         If w(i) = 0 Then r(i) = "零"
   
7.         
   
8.         If w(i) = 1 Then r(i) = "壹"
   
9.         
   
10.         If w(i) = 2 Then r(i) = "貳"
    
11.         
    
12.         If w(i) = 3 Then r(i) = "參"
    
13.         
    
14.         If w(i) = 4 Then r(i) = "肆"
    
15.         
    
16.         If w(i) = 5 Then r(i) = "伍"
    
17.         
    
18.         If w(i) = 6 Then r(i) = "陸"
    
19.         
    
20.         If w(i) = 7 Then r(i) = "柒"
    
21.         
    
22.         If w(i) = 8 Then r(i) = "捌"
    
23.         
    
24.         If w(i) = 9 Then r(i) = "玖"
    
25.    
    
26.     Next i
    
27.    
    
28.     If r(6) <> "零" Then
    
29.         z(7) = ("佰")
    
30.     Else
    
31.         z(7) = ("佰萬")
    
32.     End If
    
33.    
    
34.     If r(5) <> "零" Then
    
35.         z(6) = ("拾")
    
36.     Else
    
37.         z(6) = ("拾萬")
    
38.     End If
    
39.     z(5) = ("萬")
    
40.     z(4) = ("仟")
    
41.     z(3) = ("佰")
    
42.     z(2) = ("拾")
    
43.     z(1) = ""
    
44.     i = 1
    
45.     L = Len(word)
    
46.     aa = ""
    
47.     Do While L > 0
    
48.         If r(i) <> "零" Then
    
49.             aa = aa & r(i) & z(L)
    
50.         End If
    
51.         i = i + 1
    
52.         L = L - 1
    
53.     Loop
    
54.          Money = aa
    
55. End Function

複製代碼

PKKO

回復 1# PKKO


    抱歉,上方程式有誤,已修正如下,並修正為可使用至千萬元

1. Function Money(Mny As String) As String
   
2.     Dim w(10), z(10), r(10)
   
3.     word = Mny
   
4.     For i = 1 To Len(word)
   
5.         w(i) = Mid(word, i, 1)
   
6.         If w(i) = 0 Then r(i) = "零"
   
7.         
   
8.         If w(i) = 1 Then r(i) = "壹"
   
9.         
   
10.         If w(i) = 2 Then r(i) = "貳"
    
11.         
    
12.         If w(i) = 3 Then r(i) = "參"
    
13.         
    
14.         If w(i) = 4 Then r(i) = "肆"
    
15.         
    
16.         If w(i) = 5 Then r(i) = "伍"
    
17.         
    
18.         If w(i) = 6 Then r(i) = "陸"
    
19.         
    
20.         If w(i) = 7 Then r(i) = "柒"
    
21.         
    
22.         If w(i) = 8 Then r(i) = "捌"
    
23.         
    
24.         If w(i) = 9 Then r(i) = "玖"
    
25.    
    
26.     Next i
    
27.     If Left(Right(word, 7), 1) Then
    
28.         z(8) = ("仟")
    
29.     Else
    
30.         z(8) = ("仟萬")
    
31.     End If
    
32.     If Left(Right(word, 6), 1) <> 0 Then
    
33.         z(7) = ("佰")
    
34.     Else
    
35.         z(7) = ("佰萬")
    
36.     End If
    
37.    
    
38.     If Left(Right(word, 5), 1) <> 0 Then
    
39.         z(6) = ("拾")
    
40.     Else
    
41.         z(6) = ("拾萬")
    
42.     End If
    
43.     z(5) = ("萬")
    
44.     z(4) = ("仟")
    
45.     z(3) = ("佰")
    
46.     z(2) = ("拾")
    
47.     z(1) = ""
    
48.     i = 1
    
49.     L = Len(word)
    
50.     aa = ""
    
51.     Do While L > 0
    
52.         If r(i) <> "零" Then
    
53.             aa = aa & r(i) & z(L)
    
54.         End If
    
55.         i = i + 1
    
56.         L = L - 1
    
57.     Loop
    
58.          Money = aa
    
59. End Function

複製代碼