Board logo

標題: excel 將數字轉英文大寫 [打印本頁]
作者: seci    時間: 2010-6-22 19:34     標題: excel 將數字轉英文大寫

我在網上到這個方法 http://support.microsoft.com/kb/q213360/
但轉為大寫的英文內會有dollars這個字, 我是用在列印支票上, 所以不需要有"dollar"

example : Six Hundred Eighty Five Dollars and Thirty Three Cents

各大高手有沒有方法在excel 將數字轉英文大寫 但沒有 "dollar"字呢 ??/

Thanks.
作者: chi830    時間: 2011-7-25 15:59

回復 1# seci


    其實只要把以下行數，刪除就行了
' Select Case Dollars
'        Case ""
'            Dollars = "No Dollars"
'        Case "One"
'            Dollars = "One Dollar"
'         Case Else
'            Dollars = Dollars & " Dollars"
'    End Select
'    Select Case Cents
'        Case ""
'            Cents = " and No Cents"
'        Case "One"
'            Cents = " and One Cent"
'              Case Else
'            Cents = " and " & Cents & " Cents"
'    End Select
作者: C9212038    時間: 2014-5-23 20:09

我把那一串刪掉後變成下面的樣子(513.51---→ Five Hundred ThirteenFifty One)，但And不見了，還有Thirteen應該是空一格再接Fifty，可現在連在一起了。
如果And後面想加Cents要怎麼做呢？謝謝您！
我想要的是Five Hundred Thirteen And Cents Fifty One
作者: yen956    時間: 2014-5-24 13:53

本帖最後由 yen956 於 2014-5-24 13:55 編輯

回復 3# C9212038
試試看:
  1. Select Case Dollars
  2.     Case ""
  3. '        Dollars = "No Dollars"
  4.         Dollars = ""
  5.     Case "One"
  6. '        Dollars = "One Dollar"
  7.         Dollars = "One"
  8.     Case Else
  9. '        Dollars = Dollars & " Dollars"
  10.         Dollars = Dollars & ""
  11. End Select

  13. Select Case Cents
  14.     Case ""
  15. '        Cents = " and No Cents"
  16.         Cents = ""
  17.     Case "One"
  18.         'Five Hundred Thirteen And Cents Fifty One
  19.         '如果希望如上 Cents 放前面,
  20.         '那就下行改成 Cents = " and Cent One"
  21.         Cents = " and One Cent"
  22.     Case Else
  23.         '如果希望 Cents 放前面,
  24.         '那就下行改成 Cents = " and Cents " & Cents
  25.         Cents = " and " & Cents & " Cents"
  26. End Select
複製代碼
說明：前面加 ' 那一列是註解, 不會被VBA執行
作者: 准提部林    時間: 2014-5-26 10:19

程式碼不須改，在公式上著手：
=SUBSTITUTE(自訂函數,"Dollars ","")
作者: 准提部林    時間: 2014-5-26 10:27

〔定義名稱+公式〕數字轉英文大寫：
http://www.funp.net/246430

若有興趣，可自行套改看看∼∼
作者: softsadwind    時間: 2014-5-26 10:40

回復 1# seci
  1. Option Explicit
  2. 'Main Function
  3. Function SpellNumber(ByVal MyNumber)
  4. Dim Dollars, Cents, Temp
  5. Dim DecimalPlace, Count
  6. ReDim Place(9) As String
  7. Place(2) = " Thousand "
  8. Place(3) = " Million "
  9. Place(4) = " Billion "
  10. Place(5) = " Trillion "
  11. ' 代表數字的字串。
  12. MyNumber = Trim(Str(MyNumber))
  13. ' 如果值為無，則十進位 0 的位置。
  14. DecimalPlace = InStr(MyNumber, ".")
  15. ' 換算分然後將 MyNumber 的數字設為元。
  16. If DecimalPlace > 0 Then
  17. Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
  18.                   "00", 2))
  19. MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
  20. End If
  21. Count = 1
  22. Do While MyNumber <> ""
  23. Temp = GetHundreds(Right(MyNumber, 3))
  24. If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
  25. If Len(MyNumber) > 3 Then
  26. MyNumber = Left(MyNumber, Len(MyNumber) - 3)
  27. Else
  28. MyNumber = ""
  29. End If
  30. Count = Count + 1
  31. Loop
  32. Select Case Dollars
  33. Case ""
  34. Dollars = "No Dollars"
  35. Case "One"
  36. 'Dollars = "One Dollar"
  37. Dollars = "One"
  38. Case Else
  39. 'Dollars = Dollars & " Dollars"
  40. Dollars = Dollars
  41. End Select
  42. Select Case Cents
  43. Case ""
  44. Cents = " and No Cents"
  45. Case "One"
  46. Cents = " and One Cent"
  47. Case Else
  48. Cents = " and " & Cents & " Cents"
  49. End Select
  50. SpellNumber = Dollars & Cents
  51. End Function
  52.       
  53. ' 將數字 100-999 轉換為文字
  54. Function GetHundreds(ByVal MyNumber)
  55. Dim Result As String
  56. If Val(MyNumber) = 0 Then Exit Function
  57. MyNumber = Right("000" & MyNumber, 3)
  58. ' 換算百進位的。
  59. If Mid(MyNumber, 1, 1) <> "0" Then
  60. Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
  61. End If
  62. ' 換算十進位和一進位。
  63. If Mid(MyNumber, 2, 1) <> "0" Then
  64. Result = Result & GetTens(Mid(MyNumber, 2))
  65. Else
  66. Result = Result & GetDigit(Mid(MyNumber, 3))
  67. End If
  68. GetHundreds = Result
  69. End Function
  70.       
  71. ' 將數字 10 到 99 轉換為文字。
  72. Function GetTens(TensText)
  73. Dim Result As String
  74. Result = ""           ' Null out the temporary function value.
  75. If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
  76. Select Case Val(TensText)
  77. Case 10: Result = "Ten"
  78. Case 11: Result = "Eleven"
  79. Case 12: Result = "Twelve"
  80. Case 13: Result = "Thirteen"
  81. Case 14: Result = "Fourteen"
  82. Case 15: Result = "Fifteen"
  83. Case 16: Result = "Sixteen"
  84. Case 17: Result = "Seventeen"
  85. Case 18: Result = "Eighteen"
  86. Case 19: Result = "Nineteen"
  87. Case Else
  88. End Select
  89. Else                                 ' 如果值介於 20-99...
  90. Select Case Val(Left(TensText, 1))
  91. Case 2: Result = "Twenty "
  92. Case 3: Result = "Thirty "
  93. Case 4: Result = "Forty "
  94. Case 5: Result = "Fifty "
  95. Case 6: Result = "Sixty "
  96. Case 7: Result = "Seventy "
  97. Case 8: Result = "Eighty "
  98. Case 9: Result = "Ninety "
  99. Case Else
  100. End Select
  101. Result = Result & GetDigit _
  102. (Right(TensText, 1))  ' Retrieve ones place.
  103. End If
  104. GetTens = Result
  105. End Function
  106.      
  107. ' 將數字 1 到 9 轉換為文字。
  108. Function GetDigit(Digit)
  109. Select Case Val(Digit)
  110. Case 1: GetDigit = "One"
  111. Case 2: GetDigit = "Two"
  112. Case 3: GetDigit = "Three"
  113. Case 4: GetDigit = "Four"
  114. Case 5: GetDigit = "Five"
  115. Case 6: GetDigit = "Six"
  116. Case 7: GetDigit = "Seven"
  117. Case 8: GetDigit = "Eight"
  118. Case 9: GetDigit = "Nine"
  119. Case Else: GetDigit = ""
  120. End Select
  121. End Function
複製代碼
改掉兩個地方就好
Case "One"
'Dollars = "One Dollar" 原本的
Dollars = "One"
Case Else
'Dollars = Dollars & " Dollars" 原本的
Dollars = Dollars



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)