Board logo

標題: [發問] VBA 數字轉英文 [打印本頁]
作者: yc1031    時間: 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    時間: 2011-9-1 17:34

有人可以幫忙嗎?........
作者: oobird    時間: 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
複製代碼
作者: yc1031    時間: 2011-9-6 08:37

回復 3# oobird


真的太感謝你了, 幫我一個大忙. 謝謝~~~
作者: mikan    時間: 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



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