返回列表 上一主題 發帖

[發問] VBA 數字轉英文

yc1031

帖子
106 
主題
35 
精華
0 
積分
146 
點名
0  
作業系統
Window 7 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2011-8-30 
最後登錄
2024-3-26 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2011-8-31 18:21 | 顯示全部帖子

[發問] VBA 數字轉英文

你們好!  請幫幫我修改數字轉英文的部分 (抱歉, 因無法上傳EXCEL, 所以我用貼的)


修改重點:
1. 小數點的CENTS, 要接在AND的後面
2. 在百位數時, 要加個AND

感謝!!!

123.55         SAY TOTAL U.S. DOLLARS ONE HUNDRED TWENTY THREE DOLLARS AND FIFTY FIVE CENTS ONLY
       正確        SAY TOTAL U.S. DOLLARS ONE HUNDRED TWENTY THREE DOLLARS AND CENTS FIFTY FIVE ONLY.
123,456.00         SAY TOTAL U.S. DOLLARS ONE HUNDRED TWENTY THREE THOUSAND FOUR HUNDRED FIFTY SIX DOLLARS   ONLY
       正確        SAY TOTAL U.S. DOLLARS ONE HUNDRED TWENTY THREE THOUSAND AND FOUR HUNDRED FIFTY SIX ONLY.
12,456.55         SAY TOTAL U.S. DOLLARS TWELVE THOUSAND FOUR HUNDRED FIFTY SIX DOLLARS AND FIFTY FIVE CENTS ONLY
       正確        SAY TOTAL U.S. DOLLARS TWELVE THOUSAND AND FOUR HUNDRED FIFTY SIX DOLLARS AND CENTS FIFTY FIVE ONLY


EXCEL
  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.     ' String representation of amount.
  12.     MyNumber = Trim(Str(MyNumber))
  13.     ' Position of decimal place 0 if none.
  14.     DecimalPlace = InStr(MyNumber, ".")
  15.     ' Convert cents and set MyNumber to dollar amount.
  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.          Case Else
  38.             Dollars = Dollars & " Dollars"
  39.     End Select
  40.     Select Case Cents
  41.         Case ""
  42.             Cents = "  "
  43.         Case "One"
  44.             Cents = " and Cent One "
  45.               Case Else
  46.             Cents = " and " & Cents & " Cents"
  47.     End Select
  48.     SpellNumber = Dollars & Cents
  49. End Function
  50.       
  51. ' Converts a number from 100-999 into text
  52. Function GetHundreds(ByVal MyNumber)
  53.     Dim Result As String
  54.     If Val(MyNumber) = 0 Then Exit Function
  55.     MyNumber = Right("000" & MyNumber, 3)
  56.     ' Convert the hundreds place.
  57.     If Mid(MyNumber, 1, 1) <> "0" Then
  58.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
  59.     End If
  60.     ' Convert the tens and ones place.
  61.     If Mid(MyNumber, 2, 1) <> "0" Then
  62.         Result = Result & GetTens(Mid(MyNumber, 2))
  63.     Else
  64.         Result = Result & GetDigit(Mid(MyNumber, 3))
  65.     End If
  66.     GetHundreds = Result
  67. End Function
  68.       
  69. ' Converts a number from 10 to 99 into text.
  70. Function GetTens(TensText)
  71.     Dim Result As String
  72.     Result = ""           ' Null out the temporary function value.
  73.     If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
  74.         Select Case Val(TensText)
  75.             Case 10: Result = "Ten"
  76.             Case 11: Result = "Eleven"
  77.             Case 12: Result = "Twelve"
  78.             Case 13: Result = "Thirteen"
  79.             Case 14: Result = "Fourteen"
  80.             Case 15: Result = "Fifteen"
  81.             Case 16: Result = "Sixteen"
  82.             Case 17: Result = "Seventeen"
  83.             Case 18: Result = "Eighteen"
  84.             Case 19: Result = "Nineteen"
  85.             Case Else
  86.         End Select
  87.     Else                                 ' If value between 20-99...
  88.         Select Case Val(Left(TensText, 1))
  89.             Case 2: Result = "Twenty "
  90.             Case 3: Result = "Thirty "
  91.             Case 4: Result = "Forty "
  92.             Case 5: Result = "Fifty "
  93.             Case 6: Result = "Sixty "
  94.             Case 7: Result = "Seventy "
  95.             Case 8: Result = "Eighty "
  96.             Case 9: Result = "Ninety "
  97.             Case Else
  98.         End Select
  99.         Result = Result & GetDigit _
  100.             (Right(TensText, 1))  ' Retrieve ones place.
  101.     End If
  102.     GetTens = Result
  103. End Function
  104.      
  105. ' Converts a number from 1 to 9 into text.
  106. Function GetDigit(Digit)
  107.     Select Case Val(Digit)
  108.         Case 1: GetDigit = "One"
  109.         Case 2: GetDigit = "Two"
  110.         Case 3: GetDigit = "Three"
  111.         Case 4: GetDigit = "Four"
  112.         Case 5: GetDigit = "Five"
  113.         Case 6: GetDigit = "Six"
  114.         Case 7: GetDigit = "Seven"
  115.         Case 8: GetDigit = "Eight"
  116.         Case 9: GetDigit = "Nine"
  117.         Case Else: GetDigit = ""
  118.     End Select
  119. End Function
複製代碼
收藏 分享

yc1031

帖子
106 
主題
35 
精華
0 
積分
146 
點名
0  
作業系統
Window 7 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2011-8-30 
最後登錄
2024-3-26 
2#
發表於 2011-9-1 17:34 | 顯示全部帖子
有人可以幫忙嗎?........

TOP

yc1031

帖子
106 
主題
35 
精華
0 
積分
146 
點名
0  
作業系統
Window 7 
軟體版本
2007 
閱讀權限
20 
性別
女 
註冊時間
2011-8-30 
最後登錄
2024-3-26 
3#
發表於 2011-9-6 08:37 | 顯示全部帖子
回復 3# oobird


真的太感謝你了, 幫我一個大忙. 謝謝~~~

TOP

        靜思自在 : 難行能行，難捨能捨，難為能為，才能昇華自我的人格。
返回列表 上一主題