ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] VBA ¼Æ¦rÂà­^¤å

[µo°Ý] VBA ¼Æ¦rÂà­^¤å

§A­Ì¦n!  ½ÐÀ°À°§Ú­×§ï¼Æ¦rÂà­^¤åªº³¡¤À (©êºp, ¦]µLªk¤W¶ÇEXCEL, ©Ò¥H§Ú¥Î¶Kªº)


­×§ï­«ÂI:
1. ¤p¼ÆÂIªºCENTS, ­n±µ¦bANDªº«á­±
2. ¦b¦Ê¦ì¼Æ®É, ­n¥[­ÓAND

·PÁÂ!!!

123.55         SAY TOTAL U.S. DOLLARS ONE HUNDRED TWENTY THREE DOLLARS AND FIFTY FIVE CENTS ONLY
       ¥¿½T        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
       ¥¿½T        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
       ¥¿½T        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
½Æ»s¥N½X

¦³¤H¥i¥HÀ°¦£¶Ü?........

TOP

  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
½Æ»s¥N½X

TOP

¦^´_ 3# oobird


¯uªº¤Ó·PÁ§A¤F, À°§Ú¤@­Ó¤j¦£. ÁÂÁÂ~~~

TOP

¦b2007¤¤«Ø¥ß³o­Ó¥¨¶°¡A¦ý°õ¦æ«á¡A¦³»yªk¿ù»~
¬õ¦â²ÊÅé¬O¤£¬O´N¬O¦³°ÝÃDªº¦a¤è¡H½Ð°Ý¸Ó¦p¦ó­×¥¿¡H

ÁÂÁ¡C


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

        ÀR«ä¦Û¦b : ¤@­Ó¤Hªº§Ö¼Ö¡D¤£¬O¦]¬°¥L¾Ö¦³±o¦h¡A¦Ó¬O¦]¬°¥L­p¸û±o¤Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD