SPELLNUMBER
Returns the text after converting a number into words.
Remarks
You can use the SPELLNUMBERREVERSE function to go in the opposite direction.
For instructions on how to add a function to a workbook refer to the page under Inserting Functions
* The equivalent JavaScript function is SPELLNUMBER
* Thanks to Bernd Plumhoff (sulprobil.com) for his contribution.
 |
This function returns the same value for positive and negative numbers.
All numbers will be rounded to the nearest 2 decimal places.
This function will only return the correct text for numbers less than 999,999,999,999,999 (nine hundred trillion).
link - http://cpap.com.br/orlando/excelspellnumbermore.asp
link - support.microsoft.com/en-gb/office/convert-numbers-into-words-a0d166fb-e1ea-4090-95c8-69442cd55d98
dbMyNumber - The number you want to convert to text.
sMainUnitPlural - The unit to use for whole numbers.
sMainUnitSingle - The unit to use for single whole numbers.
sDecimalUnitPlural - (Optional) The unit to use for decimal values.
sDecimalUnitSingle - (Optional) The unit to use for single decimal values.
Public Function SPELLNUMBER(ByVal dbMyNumber As Double, _
ByVal sMainUnitPlural As String, _
ByVal sMainUnitSingle As String, _
Optional ByVal sDecimalUnitPlural As String = "", _
Optional ByVal sDecimalUnitSingle As String = "") As Variant
Dim sMyNumber As String
Dim sConcat As String
Dim sDecimalText As String
Dim sTemp As String
Dim iDecimalPlace As Integer
Dim iCount As Integer
ReDim Place(9) As String
Application.Volatile (True)
Place(2) = "Thousand"
Place(3) = "Million"
Place(4) = "Billion"
Place(5) = "Trillion"
sMyNumber = Trim(CStr(dbMyNumber))
iDecimalPlace = InStr(dbMyNumber, ".")
If (iDecimalPlace > 0) Then
sDecimalText = GetTens(Left(Mid(Round(sMyNumber, 2), iDecimalPlace + 1) & "00", 2))
If Len(sDecimalText) > 0 Then
sMyNumber = Trim(Left(sMyNumber, iDecimalPlace - 1))
Else
sMyNumber = ""
End If
End If
iCount = 1
Do While sMyNumber <> ""
sTemp = GetHundreds(sMyNumber, Right(sMyNumber, 3), iDecimalPlace)
If (sTemp <> "") Then
If (iCount > 1) And (LCase(Left(Trim(sConcat), 3)) <> "and") Then
sConcat = ", " & sConcat
End If
sConcat = sTemp & Place(iCount) & sConcat
End If
If (Len(sMyNumber) > 3) Then
sMyNumber = Left(sMyNumber, Len(sMyNumber) - 3)
Else
sMyNumber = ""
End If
iCount = iCount + 1
Loop
Select Case Trim(sConcat)
Case "": sConcat = "No " & sMainUnitPlural
Case "One": sConcat = "One " & sMainUnitSingle
Case Else: sConcat = sConcat & sMainUnitPlural
End Select
If (iDecimalPlace > 0) Then
If (Len(sDecimalUnitPlural) > 0 And Len(sDecimalUnitSingle) > 0) Then
sConcat = sConcat & ", "
Select Case Trim(sDecimalText)
Case "": sDecimalText = "No " & sDecimalUnitPlural
Case "One": sDecimalText = "One " & sDecimalUnitSingle
Case Else: sDecimalText = sDecimalText & sDecimalUnitPlural
End Select
Else
sConcat = sConcat & " and "
sDecimalText = Mid(Trim(Str(dbMyNumber)), iDecimalPlace + 1) & "/100"
End If
End If
SPELLNUMBER = Trim(sConcat & sDecimalText)
End Function
Function GetHundreds(ByVal sMyNumber As String, _
ByVal sHundredNumber As String, _
ByVal iDecimal As Integer) As String
Dim sResult As String
If (sHundredNumber = "0") Then
Exit Function
End If
sHundredNumber = Right("000" & sHundredNumber, 3)
If Mid(sHundredNumber, 1, 1) <> "0" Then
sResult = GetDigit(Mid(sHundredNumber, 1, 1)) & "Hundred"
End If
If (sMyNumber > 1000) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
Mid(sHundredNumber, 2, 1) <> "0") Or _
(Len(sResult) > 0) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
Mid(sHundredNumber, 2, 1) <> "0") Then
sResult = sResult & " and "
End If
If Mid(sHundredNumber, 2, 1) <> "0" Then
sResult = sResult & GetTens(Mid(sHundredNumber, 2))
Else
If Mid(sHundredNumber, 3, 1) <> "0" Then
sResult = sResult & GetDigit(Mid(sHundredNumber, 3))
Else
sResult = sResult & " "
End If
End If
GetHundreds = sResult
End Function
Function GetTens(ByVal sTensText As String) As String
Dim sResult As String
sResult = ""
If Left(sTensText, 1) = 1 Then
Select Case sTensText
Case "10": sResult = "Ten "
Case "11": sResult = "Eleven "
Case "12": sResult = "Twelve "
Case "13": sResult = "Thirteen "
Case "14": sResult = "Fourteen "
Case "15": sResult = "Fifteen "
Case "16": sResult = "Sixteen "
Case "17": sResult = "Seventeen "
Case "18": sResult = "Eighteen "
Case "19": sResult = "Nineteen "
Case Else
End Select
Else
Select Case Left(sTensText, 1)
Case "2": sResult = "Twenty "
Case "3": sResult = "Thirty "
Case "4": sResult = "Forty "
Case "5": sResult = "Fifty "
Case "6": sResult = "Sixty "
Case "7": sResult = "Seventy "
Case "8": sResult = "Eighty "
Case "9": sResult = "Ninety "
Case Else
End Select
sResult = sResult & GetDigit(Right(sTensText, 1))
End If
GetTens = sResult
End Function
Function GetDigit(ByVal sDigit As String) As String
Select Case sDigit
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
© 2024 Better Solutions Limited. All Rights Reserved. © 2024 Better Solutions Limited TopPrevNext