在 Excel 入面 , 按alt + f11 開 Visual Basic Editor
insert > module
把以下文字copy, paste上 module 視窗入面
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim DOLLARS, CENTS
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " THOUSAND "
Place(3) = " MILLION "
Place(4) = " BILLION "
Place(5) = " TRILLION "
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")
' If we find decimal place...
If DecimalPlace > 0 Then
' Convert CENTS
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
CENTS = ConvertTENs(Temp)
' Strip off CENTS from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If
Count = 1 Do While MyNumber <> "" ' Convert last 3 digits of MyNumber to English DOLLARS. Temp = ConvertHUNDREDs(Right(MyNumber, 3)) If Temp <> "" Then DOLLARS = Temp & Place(Count) & DOLLARS If Len(MyNumber) > 3 Then ' Remove last 3 converted digits from MyNumber. MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop
' Clean up DOLLARS. Select Case DOLLARS Case "" DOLLARS = "" Case "ONE" DOLLARS = "ONE DOLLAR" Case Else DOLLARS = DOLLARS & " DOLLARS" End Select
' Clean up CENTS. Select Case CENTS Case "" CENTS = " " Case "ONE" CENTS = " AND ONE CENT" Case Else CENTS = " AND " & CENTS & " CENTS" End Select
ConvertCurrencyToEnglish = DOLLARS & CENTS End Function
Private Function ConvertHUNDREDs(ByVal MyNumber) Dim Result As String
' Exit if there is nothing to convert. If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number. MyNumber = Right("000" & MyNumber, 3)
' Do we have a HUNDREDs place digit to convert? If Left(MyNumber, 1) <> "0" Then Result = ConvertDigit(Left(MyNumber, 1)) & " HUNDRED " End If
' Do we have a TENs place digit to convert? If Mid(MyNumber, 2, 1) <> "0" Then Result = Result & ConvertTENs(Mid(MyNumber, 2)) Else ' If not, then convert the ONEs place digit. Result = Result & ConvertDigit(Mid(MyNumber, 3)) End If
ConvertHUNDREDs = Trim(Result) End Function
Private Function ConvertTENs(ByVal MyTENs) Dim Result As String
' Is value between 10 AND 19? If Val(Left(MyTENs, 1)) = 1 Then Select Case Val(MyTENs) 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 ' .. otherwise it's between 20 AND 99. Select Case Val(Left(MyTENs, 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
' Convert ONEs place digit. Result = Result & ConvertDigit(Right(MyTENs, 1)) End If
ConvertTENs = Result End Function
Private Function ConvertDigit(ByVal MyDigit) Select Case Val(MyDigit) Case 1: ConvertDigit = "ONE" Case 2: ConvertDigit = "TWO" Case 3: ConvertDigit = "THREE" Case 4: ConvertDigit = "FOUR" Case 5: ConvertDigit = "FIVE" Case 6: ConvertDigit = "SIX" Case 7: ConvertDigit = "SEVEN" Case 8: ConvertDigit = "EIGHT" Case 9: ConvertDigit = "NINE" Case Else: ConvertDigit = "" End Select End Function
沒有留言:
張貼留言