如何在Excel中快速将数字转换为英文单词？

Function WordsToDigits(theWordCell As Range) As Currency Dim curPart As String Dim theDigits As Currency Dim Pt1 As Integer Dim Pt2 As Integer Dim Trillions As Currency Dim Billions As Currency Dim Millions As Currency Dim Thousands As Currency Dim Hundreds As Currency Dim Tens As Currency Dim Units As Currency Dim whatGroup As String Dim theFraction As Double Dim hasFraction As Boolean If IsEmpty(theWordCell) Then Exit Function End If theWords = UCase(Trim(Application.WorksheetFunction.Clean(theWordCell))) theWords = Replace(theWords, "-", " ") theWords = Replace(theWords, "DOLLARS", " ") theWords = Replace(theWords, "DOLLAR", " ") Do While InStr(theWords, " ") > 0 theWords = Replace(theWords, " ", " ") Loop If InStr(theWords, "/") > 0 Or InStr(theWords, " AND ") > 0 Then hasFraction = True theFraction = CalculateTheFraction() End If Trillions = EvaluateGroupValue(oneTrillion) Billions = EvaluateGroupValue(oneBillion) Millions = EvaluateGroupValue(oneMillion) Thousands = EvaluateGroupValue(oneThousand) If InStr(theWords, oneHundred) > 0 Then curPart = Left(theWords, InStr(theWords, oneHundred) + Len(oneHundred)) theWords = Right(theWords, Len(theWords) - Len(curPart)) Hundreds = GetHundreds(curPart) End If theWords = Trim(theWords) Tens = GetTens(theWords) theDigits = CCur((Trillions * 1000000000000#)) + CCur((Billions * 1000000000#)) + _ CCur((Millions * 1000000#)) + CCur((Thousands * 1000)) + CCur((Hundreds * 100)) + Tens If hasFraction Then theDigits = theDigits + theFraction End If WordsToDigits = theDigits End Function

Private Function EvaluateGroupValue(strGroup As String) As Currency Dim curPart As String If InStr(theWords, strGroup) > 0 Then curPart = Left(theWords, InStr(theWords, strGroup) + Len(strGroup)) theWords = Right(theWords, Len(theWords) - Len(curPart)) EvaluateGroupValue = GetLargeValues(curPart, strGroup) End If End Function

Private Function GetLargeValues(strAmount As String, strGroup As String) As Currency Dim tempText As String Dim theTens As String Dim theUnits As String tempText = Trim(Left(strAmount, InStr(strAmount, strGroup) - 1)) tempText = Replace(tempText, strGroup, "") If InStr(tempText, " " & oneHundred) > 0 Then tempText = Replace(tempText, " " & oneHundred, "") If InStr(tempText, " ") > 0 Then GetLargeValues = GetUnits(Left(tempText, InStr(tempText, " ") - 1)) * 100 tempText = Right(tempText, Len(tempText) - InStr(tempText, " ")) If InStr(tempText, " ") > 0 Then theTens = GetUnits(Left(tempText, InStr(tempText, " ") - 1)) theUnits = GetUnits(Trim(Right(tempText, Len(tempText) - InStr(tempText, " ")))) GetLargeValues = GetLargeValues + theTens + theUnits Else GetLargeValues = GetLargeValues + GetUnits(tempText) End If Else GetLargeValues = GetUnits(tempText) * 100 End If Exit Function End If If InStr(tempText, " ") > 0 Then GetLargeValues = GetUnits(Left(tempText, InStr(tempText, " ") - 1)) GetLargeValues = GetLargeValues + GetUnits(Right(tempText, Len(tempText) - InStr(tempText, " "))) Else GetLargeValues = GetUnits(tempText) End If End Function

Private Function GetHundreds(strAmount As String) As Integer Dim tempText As String tempText = Trim(Left(strAmount, InStr(strAmount, oneHundred) - 1)) If InStr(tempText, " ") > 0 Then GetHundreds = GetUnits(Left(tempText, InStr(tempText, " ") - 1)) GetHundreds = GetHundreds + GetUnits(Right(tempText, Len(tempText) - InStr(tempText, " "))) Else GetHundreds = GetUnits(tempText) End If End Function

Private Function GetTens(strAmount As String) As Integer Dim tempText As String tempText = Trim(strAmount) If InStr(tempText, " ") > 0 Then GetTens = GetUnits(Left(tempText, InStr(tempText, " ") - 1)) GetTens = GetTens + GetUnits(Right(tempText, Len(tempText) - InStr(tempText, " "))) Else GetTens = GetUnits(tempText) End If End Function

Private Function GetUnits(strAmount As String) As Integer Dim tempText As String tempText = Trim(strAmount) Select Case tempText Case Is = "ONE" GetUnits = 1 Case Is = "TWO" GetUnits = 2 Case Is = "THREE" GetUnits = 3 Case Is = "FOUR" GetUnits = 4 Case Is = "FIVE" GetUnits = 5 Case Is = "SIX" GetUnits = 6 Case Is = "SEVEN" GetUnits = 7 Case Is = "EIGHT" GetUnits = 8 Case Is = "NINE" GetUnits = 9 Case Is = "TEN" GetUnits = 10 Case Is = "ELEVEN" GetUnits = 11 Case Is = "TWELVE" GetUnits = 12 Case Is = "THIRTEEN" GetUnits = 13 Case Is = "FOURTEEN" GetUnits = 14 Case Is = "FIFTEEN" GetUnits = 15 Case Is = "SIXTEEN" GetUnits = 16 Case Is = "SEVENTEEN" GetUnits = 17 Case Is = "EIGHTEEN" GetUnits = 18 Case Is = "NINETEEN" GetUnits = 19 Case Is = "TWENTY" GetUnits = 20 Case Is = "THIRTY" GetUnits = 30 Case Is = "FORTY", "FOURTY" GetUnits = 40 Case Is = "FIFTY" GetUnits = 50 Case Is = "SIXTY" GetUnits = 60 Case Is = "SEVENTY" GetUnits = 70 Case Is = "EIGHTY" GetUnits = 80 Case Is = "NINETY" GetUnits = 90 Case Else GetUnits = 0 End Select End Function

Private Function CalculateTheFraction() As Double Dim fractionPart As String Dim tempValue As Double Dim toPower As Integer Dim theDivisor As Double If InStr(theWords, " AND ") > 0 Then fractionPart = Right(theWords, Len(theWords) - InStr(theWords, " AND ") - 4) theWords = Left(theWords, InStr(theWords, " AND ") - 1) End If If InStr(fractionPart, "/") > 0 Then tempValue = Val(fractionPart) theDivisor = Right(fractionPart, Len(fractionPart) - InStr(fractionPart, "/")) CalculateTheFraction = tempValue / theDivisor Exit Function End If tempValue = Val(fractionPart) toPower = Len(CStr(tempValue)) theDivisor = 10 ^ toPower CalculateTheFraction = tempValue / theDivisor End Function