返回列表 上一主題 發帖

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

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-4-21 15:13 | 只看該作者

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

本帖最後由 PKKO 於 2015-4-21 15:21 編輯

各位大大好,此為小弟在網路上搜尋之後進行小改版,方便各位直接使用
重要說明:因為小弟的金額只用到佰萬元以內,因此此程式只適用於佰萬元以內,若要增加可自行修改
方式如下
一、插入模組
二、將此程式碼完整貼上
三、在公式的位置直接打上=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

PKKO
　暱稱: PKKO

高中生Rank: 3Rank: 3

帖子
549 
主題
152 
精華
0 
積分
691 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2010 
閱讀權限
50 
性別
男 
註冊時間
2013-8-10 
最後登錄
2022-9-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2015-4-21 15:37 | 只看該作者
回復 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
複製代碼

2.png (6.76 KB)

2.png

PKKO

TOP

        靜思自在 : 世上有兩件事不能等：一、孝順 二、行善。
返回列表 上一主題