返回列表 上一主題 發帖

[發問] 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
複製代碼
收藏 分享

mikan

帖子
39 
主題
16 
精華
0 
積分
118 
點名
225  
作業系統
windows 2000 
軟體版本
office 2003 
閱讀權限
20 
註冊時間
2010-7-7 
最後登錄
2024-11-24 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章
5#
發表於 2012-6-8 13:22 | 只看該作者
在2007中建立這個巨集，但執行後，有語法錯誤
紅色粗體是不是就是有問題的地方？請問該如何修正？

謝謝。


Function SpellNumber(ByVal MyNumber)

    Dim Dollars, Cents, Temp

    Dim DecimalPlace, Count

    ReDim Place(9) As String

    Place(2) = " Thousand "

    Place(3) = " Million "

    Place(4) = " Billion "

    Place(5) = " Trillion "

    ' String representation of amount.

    MyNumber = Trim(Str(MyNumber))

    ' Position of decimal place 0 if none.

    DecimalPlace = InStr(MyNumber, ".")

    ' Convert cents and set MyNumber to dollar amount.

    If DecimalPlace > 0 Then

       Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _

                  "00", 2))

        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))

    End If

    Count = 1

    Do While MyNumber <> ""

        Temp = GetHundreds(Right(MyNumber, 3))

        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars

        If Len(MyNumber) > 3 Then

        Dollars = " and " & Dollars

            MyNumber = Left(MyNumber, Len(MyNumber) - 3)

        Else

            MyNumber = ""

        End If

        Count = Count + 1

    Loop

    Select Case Dollars

        Case ""

            Dollars = "No Dollars"

        Case "One"

            Dollars = "One Dollar"

         Case Else

            Dollars = Dollars & " Dollars"

    End Select

    Select Case Cents

        Case ""

            Cents = " only "

        Case "One"

            Cents = " and Cent One  only"

              Case Else

            Cents = " and  Cents " & Cents & " only"

    End Select

    SpellNumber = Dollars & Cents

End Function

      

' Converts a number from 100-999 into text

Function GetHundreds(ByVal MyNumber)

    Dim Result As String

    If Val(MyNumber) = 0 Then Exit Function

    MyNumber = Right("000" & MyNumber, 3)

    ' Convert the hundreds place.

    If Mid(MyNumber, 1, 1) <> "0" Then

        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

    End If

    ' Convert the tens and ones place.

    If Mid(MyNumber, 2, 1) <> "0" Then

        Result = Result & GetTens(Mid(MyNumber, 2))

    Else

        Result = Result & GetDigit(Mid(MyNumber, 3))

    End If

    GetHundreds = Result '

End Function

      

' Converts a number from 10 to 99 into text.

Function GetTens(TensText)

    Dim Result As String

    Result = ""           ' Null out the temporary function value.

    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...

        Select Case Val(TensText)

            Case 10: Result = "Ten"

            Case 11: Result = "Eleven"

            Case 12: Result = "Twelve"

            Case 13: Result = "Thirteen"

            Case 14: Result = "Fourteen"

            Case 15: Result = "Fifteen"

            Case 16: Result = "Sixteen"

            Case 17: Result = "Seventeen"

            Case 18: Result = "Eighteen"

            Case 19: Result = "Nineteen"

            Case Else

        End Select

    Else                                 ' If value between 20-99...

        Select Case Val(Left(TensText, 1))

            Case 2: Result = "Twenty "

            Case 3: Result = "Thirty "

            Case 4: Result = "Forty "

            Case 5: Result = "Fifty "

            Case 6: Result = "Sixty "

            Case 7: Result = "Seventy "

            Case 8: Result = "Eighty "

            Case 9: Result = "Ninety "

            Case Else

        End Select

        Result = Result & GetDigit _

            (Right(TensText, 1))  ' Retrieve ones place.
    End If

    GetTens = Result

End Function

     

' Converts a number from 1 to 9 into text.

Function GetDigit(Digit)

    Select Case Val(Digit)

        Case 1: GetDigit = "One"

        Case 2: GetDigit = "Two"

        Case 3: GetDigit = "Three"

        Case 4: GetDigit = "Four"

        Case 5: GetDigit = "Five"

        Case 6: GetDigit = "Six"

        Case 7: GetDigit = "Seven"

        Case 8: GetDigit = "Eight"

        Case 9: GetDigit = "Nine"

        Case Else: GetDigit = ""

    End Select

End Function

TOP

yc1031

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


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

TOP

oobird
　頭銜: 街友一族

超級版主Rank: 8Rank: 8

帖子
1572 
主題
16 
精華
2 
積分
1521 
點名
0  
作業系統
xp 
軟體版本
office 2003 
閱讀權限
150 
性別
男 
註冊時間
2010-5-1 
最後登錄
2016-1-13 

論壇貢獻勳章
3#
發表於 2011-9-1 19:35 | 只看該作者
  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.         Dollars = " and " & Dollars
  27.             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
  28.         Else
  29.             MyNumber = ""
  30.         End If
  31.         Count = Count + 1
  32.     Loop
  33.     Select Case Dollars
  34.         Case ""
  35.             Dollars = "No Dollars"
  36.         Case "One"
  37.             Dollars = "One Dollar"
  38.          Case Else
  39.             Dollars = Dollars & " Dollars"
  40.     End Select
  41.     Select Case Cents
  42.         Case ""
  43.             Cents = " only "
  44.         Case "One"
  45.             Cents = " and Cent One  only"
  46.               Case Else
  47.             Cents = " and  Cents " & Cents & " only"
  48.     End Select
  49.     SpellNumber = Dollars & Cents
  50. End Function
  51.       
  52. ' Converts a number from 100-999 into text
  53. Function GetHundreds(ByVal MyNumber)
  54.     Dim Result As String
  55.     If Val(MyNumber) = 0 Then Exit Function
  56.     MyNumber = Right("000" & MyNumber, 3)
  57.     ' Convert the hundreds place.
  58.     If Mid(MyNumber, 1, 1) <> "0" Then
  59.         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
  60.     End If
  61.     ' Convert the tens and ones place.
  62.     If Mid(MyNumber, 2, 1) <> "0" Then
  63.         Result = Result & GetTens(Mid(MyNumber, 2))
  64.     Else
  65.         Result = Result & GetDigit(Mid(MyNumber, 3))
  66.     End If
  67.     GetHundreds = Result '
  68. End Function
  69.       
  70. ' Converts a number from 10 to 99 into text.
  71. Function GetTens(TensText)
  72.     Dim Result As String
  73.     Result = ""           ' Null out the temporary function value.
  74.     If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
  75.         Select Case Val(TensText)
  76.             Case 10: Result = "Ten"
  77.             Case 11: Result = "Eleven"
  78.             Case 12: Result = "Twelve"
  79.             Case 13: Result = "Thirteen"
  80.             Case 14: Result = "Fourteen"
  81.             Case 15: Result = "Fifteen"
  82.             Case 16: Result = "Sixteen"
  83.             Case 17: Result = "Seventeen"
  84.             Case 18: Result = "Eighteen"
  85.             Case 19: Result = "Nineteen"
  86.             Case Else
  87.         End Select
  88.     Else                                 ' If value between 20-99...
  89.         Select Case Val(Left(TensText, 1))
  90.             Case 2: Result = "Twenty "
  91.             Case 3: Result = "Thirty "
  92.             Case 4: Result = "Forty "
  93.             Case 5: Result = "Fifty "
  94.             Case 6: Result = "Sixty "
  95.             Case 7: Result = "Seventy "
  96.             Case 8: Result = "Eighty "
  97.             Case 9: Result = "Ninety "
  98.             Case Else
  99.         End Select
  100.         Result = Result & GetDigit _
  101.             (Right(TensText, 1))  ' Retrieve ones place.
  102.     End If
  103.     GetTens = Result
  104. End Function
  105.      
  106. ' Converts a number from 1 to 9 into text.
  107. Function GetDigit(Digit)
  108.     Select Case Val(Digit)
  109.         Case 1: GetDigit = "One"
  110.         Case 2: GetDigit = "Two"
  111.         Case 3: GetDigit = "Three"
  112.         Case 4: GetDigit = "Four"
  113.         Case 5: GetDigit = "Five"
  114.         Case 6: GetDigit = "Six"
  115.         Case 7: GetDigit = "Seven"
  116.         Case 8: GetDigit = "Eight"
  117.         Case 9: GetDigit = "Nine"
  118.         Case Else: GetDigit = ""
  119.     End Select
  120. End Function
複製代碼

TOP

yc1031

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

TOP

        靜思自在 : 信心、毅力、勇氣三者具備，則天下沒有做不成的事。
返回列表 上一主題