Convertir un número en letra en español en Excel
Esta macro es una adaptación de la macro "How to convert a numeric value into English words in Excel" que Microsoft tiene colgada aquí
https://support.microsoft.com/es-es/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excel
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Euros, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mil "
Place(3) = " Millones "
Place(4) = " Mil Millones "
Place(5) = " Billones "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if nUn.
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 Euros = Temp & Place(Count) & Euros
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "Cero Euros"
Case "Un"
Euros = "Un Euro"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = ""
Case "Un"
Cents = " y Un Centimo"
Case Else
Cents = " y " & Cents & " Centimos"
End Select
SpellNumber = Euros & Cents
SpellNumber = Replace(SpellNumber, "Un Mil ", "Mil ")
SpellNumber = Replace(SpellNumber, "Un Millones ", "Un Millón ")
SpellNumber = Replace(SpellNumber, "Un Mil Millones ", "Mil Millones ")
SpellNumber = Replace(SpellNumber, "Un Billones ", "Un Billón ")
SpellNumber = Replace(SpellNumber, " y Mil ", " y Un Mil ")
SpellNumber = Replace(SpellNumber, " y Un Millón ", " y Un Millones ")
SpellNumber = Replace(SpellNumber, " y Mil Millones ", " y Un Mil Millones ")
SpellNumber = Replace(SpellNumber, " y Un Billón ", " y Un Billones ")
SpellNumber = Replace(SpellNumber, " ", " ")
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 MyNumber = "100" Then
Result = "Cien "
ElseIf Mid(MyNumber, 1, 1) = "1" Then
Result = "Ciento "
ElseIf Mid(MyNumber, 1, 1) = "5" Then
Result = "Quinientos "
ElseIf Mid(MyNumber, 1, 1) = "7" Then
Result = "Setecientos "
ElseIf Mid(MyNumber, 1, 1) = "9" Then
Result = "Novecientos "
ElseIf Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & "cientos "
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 = "Diez"
Case 11: Result = "Once"
Case 12: Result = "Doce"
Case 13: Result = "Trece"
Case 14: Result = "Catorce"
Case 15: Result = "Quince"
Case 16: Result = "Dieciseis"
Case 17: Result = "Diecisiete"
Case 18: Result = "Dieciocho"
Case 19: Result = "Diecinueve"
Case Else
End Select
ElseIf Val(Left(TensText, 1)) = 2 Then ' If value between 20-29
Select Case Val(TensText)
Case 20: Result = "Veinte"
Case 21: Result = "Ventiun"
Case 22: Result = "Ventidos"
Case 23: Result = "Ventitres"
Case 24: Result = "Venticuatro"
Case 25: Result = "Venticinco"
Case 26: Result = "Ventiseis"
Case 27: Result = "Ventisiete"
Case 28: Result = "Ventiocho"
Case 29: Result = "Ventinueve"
Case Else
End Select
ElseIf Val(Right(TensText, 1)) = 0 Then ' If value between 30,40,50,60,70,80,90
Select Case Val(TensText)
Case 30: Result = "Treinta "
Case 40: Result = "Cuarenta "
Case 50: Result = "Cincuenta "
Case 60: Result = "Sesenta "
Case 70: Result = "Setenta "
Case 80: Result = "Ochenta "
Case 90: Result = "Noventa "
Case Else
End Select
Else ' If value between 31-99...
Select Case Val(Left(TensText, 1))
Case 3: Result = "Treinta y "
Case 4: Result = "Cuarenta y "
Case 5: Result = "Cincuenta y "
Case 6: Result = "Sesenta y "
Case 7: Result = "Setenta y "
Case 8: Result = "Ochenta y "
Case 9: Result = "Noventa y "
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 = "Un"
Case 2: GetDigit = "Dos"
Case 3: GetDigit = "Tres"
Case 4: GetDigit = "Cuatro"
Case 5: GetDigit = "Cinco"
Case 6: GetDigit = "Seis"
Case 7: GetDigit = "Siete"
Case 8: GetDigit = "Ocho"
Case 9: GetDigit = "Nueve"
Case Else: GetDigit = ""
End Select
End Function
https://support.microsoft.com/es-es/help/213360/how-to-convert-a-numeric-value-into-english-words-in-excel
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Euros, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mil "
Place(3) = " Millones "
Place(4) = " Mil Millones "
Place(5) = " Billones "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if nUn.
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 Euros = Temp & Place(Count) & Euros
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Euros
Case ""
Euros = "Cero Euros"
Case "Un"
Euros = "Un Euro"
Case Else
Euros = Euros & " Euros"
End Select
Select Case Cents
Case ""
Cents = ""
Case "Un"
Cents = " y Un Centimo"
Case Else
Cents = " y " & Cents & " Centimos"
End Select
SpellNumber = Euros & Cents
SpellNumber = Replace(SpellNumber, "Un Mil ", "Mil ")
SpellNumber = Replace(SpellNumber, "Un Millones ", "Un Millón ")
SpellNumber = Replace(SpellNumber, "Un Mil Millones ", "Mil Millones ")
SpellNumber = Replace(SpellNumber, "Un Billones ", "Un Billón ")
SpellNumber = Replace(SpellNumber, " y Mil ", " y Un Mil ")
SpellNumber = Replace(SpellNumber, " y Un Millón ", " y Un Millones ")
SpellNumber = Replace(SpellNumber, " y Mil Millones ", " y Un Mil Millones ")
SpellNumber = Replace(SpellNumber, " y Un Billón ", " y Un Billones ")
SpellNumber = Replace(SpellNumber, " ", " ")
If InStr(1, SpellNumber, "Millones") > 0 Then
If InStr(InStr(1, SpellNumber, "Millones") + 1, SpellNumber, "Millones") > InStr(1, SpellNumber, "Millones") Then SpellNumber = Replace(SpellNumber, "Mil Millones", "Mil")
End If
SpellNumber = Replace(SpellNumber, "Millones Euros", "Millones de Euros")
SpellNumber = Replace(SpellNumber, "Millón Euros", "Millón de Euros")
SpellNumber = Replace(SpellNumber, "Billones Euros", "Billones de Euros")
SpellNumber = Replace(SpellNumber, "Billón Euros", "Billón de Euros")
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 MyNumber = "100" Then
Result = "Cien "
ElseIf Mid(MyNumber, 1, 1) = "1" Then
Result = "Ciento "
ElseIf Mid(MyNumber, 1, 1) = "5" Then
Result = "Quinientos "
ElseIf Mid(MyNumber, 1, 1) = "7" Then
Result = "Setecientos "
ElseIf Mid(MyNumber, 1, 1) = "9" Then
Result = "Novecientos "
ElseIf Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & "cientos "
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 = "Diez"
Case 11: Result = "Once"
Case 12: Result = "Doce"
Case 13: Result = "Trece"
Case 14: Result = "Catorce"
Case 15: Result = "Quince"
Case 16: Result = "Dieciseis"
Case 17: Result = "Diecisiete"
Case 18: Result = "Dieciocho"
Case 19: Result = "Diecinueve"
Case Else
End Select
ElseIf Val(Left(TensText, 1)) = 2 Then ' If value between 20-29
Select Case Val(TensText)
Case 20: Result = "Veinte"
Case 21: Result = "Ventiun"
Case 22: Result = "Ventidos"
Case 23: Result = "Ventitres"
Case 24: Result = "Venticuatro"
Case 25: Result = "Venticinco"
Case 26: Result = "Ventiseis"
Case 27: Result = "Ventisiete"
Case 28: Result = "Ventiocho"
Case 29: Result = "Ventinueve"
Case Else
End Select
ElseIf Val(Right(TensText, 1)) = 0 Then ' If value between 30,40,50,60,70,80,90
Select Case Val(TensText)
Case 30: Result = "Treinta "
Case 40: Result = "Cuarenta "
Case 50: Result = "Cincuenta "
Case 60: Result = "Sesenta "
Case 70: Result = "Setenta "
Case 80: Result = "Ochenta "
Case 90: Result = "Noventa "
Case Else
End Select
Else ' If value between 31-99...
Select Case Val(Left(TensText, 1))
Case 3: Result = "Treinta y "
Case 4: Result = "Cuarenta y "
Case 5: Result = "Cincuenta y "
Case 6: Result = "Sesenta y "
Case 7: Result = "Setenta y "
Case 8: Result = "Ochenta y "
Case 9: Result = "Noventa y "
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 = "Un"
Case 2: GetDigit = "Dos"
Case 3: GetDigit = "Tres"
Case 4: GetDigit = "Cuatro"
Case 5: GetDigit = "Cinco"
Case 6: GetDigit = "Seis"
Case 7: GetDigit = "Siete"
Case 8: GetDigit = "Ocho"
Case 9: GetDigit = "Nueve"
Case Else: GetDigit = ""
End Select
End Function
Muchas, muchas gracias, me ha servido de mucho.. sólo tengo un detallito... cuando la cifra es de un millón y algo mas... en letras dice Millones, cuando debería decir Un millón algo... ejemplo: 1.803.380... en letras dice: "Millones Ochocientos Tres Mil Trescientos Ochenta".... Me puedes ayudar?... Mil y mil gracias (icaluna18@gmail.com)
ResponderEliminarEntra al editor nuevamente con alt+f11 y situate en esta parte del codigo:
EliminarEnd Select
SpellNumber = Euros & Cents
SpellNumber = Replace(SpellNumber, "Un Mil", "Mil")
SpellNumber = Replace(SpellNumber, "Un Millones", "Un Millon")
SpellNumber = Replace(SpellNumber, "Un Mil Millones", "Mil Millones")
SpellNumber = Replace(SpellNumber, "Un Billones", "Billon")
SpellNumber = Replace(SpellNumber, " ", " ")
y reeplazala x esta
End Select
SpellNumber = Euros & Cents
SpellNumber = Replace(SpellNumber, "Uno Mil", "Mil")
SpellNumber = Replace(SpellNumber, "Uno Millones", "Un Millon")
SpellNumber = Replace(SpellNumber, "Uno Mil Millones", "Mil Millones")
SpellNumber = Replace(SpellNumber, "Uno Billones", "Billon")
SpellNumber = Replace(SpellNumber, " ", " ")
Saludos, bye
Muchas gracias por la aportación, pero creo que es mejor solución poner estos espacios. Lo corrijo en el post. Espero que con esto se haya solucionado el problema.
EliminarSpellNumber = Euros & Cents
SpellNumber = Replace(SpellNumber, "Un Mil ", "Mil ")
SpellNumber = Replace(SpellNumber, "Un Millones ", "Un Millón ")
SpellNumber = Replace(SpellNumber, "Un Mil Millones ", "Mil Millones ")
SpellNumber = Replace(SpellNumber, "Un Billones ", "Un Billón ")
SpellNumber = Replace(SpellNumber, " y Mil ", " y Un Mil ")
SpellNumber = Replace(SpellNumber, " y Un Millón ", " y Un Millones ")
SpellNumber = Replace(SpellNumber, " y Mil Millones ", " y Un Mil Millones ")
SpellNumber = Replace(SpellNumber, " y Un Billón ", " y Un Billones ")
SpellNumber = Replace(SpellNumber, " ", " ")
Muchas Gracias !!!!
ResponderEliminar$ 671.088.572.891.136 Seiscientos Setenta y Un Billones Ochenta y Ocho Mil Millones Quinientos Setenta y Dos Millones Ochocientos Noventa y Un Mil Ciento Treinta y Seis Pesos
ResponderEliminar$ 1.342.177.145.782.270 #¡VALOR! Porque no sigue realizando la transformación a letras ¡?
La macro solamente está preparada para billones, no para mil billones. La puedes adaptar sin mucha complicación si necesitas cifras más altas.
Eliminary si no quiero que diga Euros, si no que solo tenga el monto escrito con letra, como puedo actualizar la macro?
ResponderEliminarBusca y reemplaza Euro por la moneda que necesites, por ejemplo peso.
Eliminarme puedes indicar cuales debo cambiar para peso, cambié todas y no me funcionó
EliminarYo he buscado Euro y remplazado todo por Peso y he ha funcionado correctamente
EliminarSaludos. Muy buena función y muy bien adaptada. Hay alguna forma de que se identifique cuando la cifra termina en millones y le ponga la palabra "de"? Para que diga por ejemplo: diez millones de euros y no solo diez millones euros. Gracias
ResponderEliminarYa lo he corregido, he añadido el siguiente código:
EliminarSpellNumber = Replace(SpellNumber, "Millones Euros", "Millones de Euros")
SpellNumber = Replace(SpellNumber, "Millón Euros", "Millón de Euros")
SpellNumber = Replace(SpellNumber, "Billones Euros", "Billones de Euros")
SpellNumber = Replace(SpellNumber, "Billón Euros", "Billón de Euros")
Muchas gracias por tu comentario
que tengo que borrar para que la función me de solo el numero con letras, sin especificar euros o centavos... ósea que solo sea el numero.
ResponderEliminarPrueba a eliminar las palabras Euros, Euro y de
EliminarExcelente trabajo, la he adecuado a mis necesidades, y la he dejado todo en mayúsculas. Felicidades al desarrollador, excelente trabajo.
ResponderEliminarSaludos desde Nicaragua.
Muchas gracias! Me alegra que te haya servido
EliminarHe copiado y pegado la función tal como está y al aplicarla al número 1.111.111.111 (mil ciento once millones ciento once mil ciento once), indica lo siguiente: mil millones ciento once millones ciento once mil ciento once, que es erróneo.
ResponderEliminarYa lo he corregido, he añadido el siguiente codigo:
EliminarIf InStr(1, SpellNumber, "Millones") > 0 Then
If InStr(InStr(1, SpellNumber, "Millones") + 1, SpellNumber, "Millones") > InStr(1, SpellNumber, "Millones") Then SpellNumber = Replace(SpellNumber, "Mil Millones", "Mil")
End If
Muchas gracias por tu comentario
hola, me podrias ayudar para dólares, pero que salga en español. gracias
ResponderEliminarBuenas tardes, necesito la ayuda para que las cantidades en Excel se convIertan en Letras, de acuerdo al ejemplo. ETERNAMENTE AGRADECIDO.
ResponderEliminarEjemplo:
S/. 1,216.86 convertirlo a UN MIL DOSCIENTOS DIECISEIS Y 86/100 SOLES
Así, como se visualiza con letras mayúsculas.
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Soles, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " UN MIL "
Place(3) = " MILLONES "
Place(4) = " MIL MILLONES "
Place(5) = " BILLONES "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if nUn.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to SOLES amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00" / 100))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then SOLES = Temp & Place(Count) & SOLES
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case SOLES
Case ""
SOLES = "CERO SOLES"
Case "UN"
SOLES = "UN SOL"
Case Else
SOLES = SOLES & " SOLES"
End Select
Select Case Cents
Case ""
Cents = ""
Case "Un"
Cents = " y 1 /100"
Case Else
Cents = " y " & Cents & " Centimos"
End Select
SpellNumber = SOLES & Cents
SpellNumber = Replace(SpellNumber, "Uno Mil", "MIL")
SpellNumber = Replace(SpellNumber, "Uno Millones", "UN MILLON")
SpellNumber = Replace(SpellNumber, "Uno Mil Millones", "MIL MILLONES")
SpellNumber = Replace(SpellNumber, "Uno Billones", "BILLON")
SpellNumber = Replace(SpellNumber, " ", " ")
SpellNumber = Replace(SpellNumber, " y MIL ", " y Un Mil ")
SpellNumber = Replace(SpellNumber, " y UN MILLON ", " y Un Millones ")
SpellNumber = Replace(SpellNumber, " y MIL MILLONES ", " y Un Mil Millones ")
SpellNumber = Replace(SpellNumber, " y UN BILLON ", " y Un Billones ")
SpellNumber = Replace(SpellNumber, " ", " ")
If InStr(1, SpellNumber, "MILLONES") > 0 Then
If InStr(InStr(1, SpellNumber, "MILLONES") + 1, SpellNumber, "MILLONES") > InStr(1, SpellNumber, "MILLONES") Then SpellNumber = Replace(SpellNumber, "MIL MILLONES", "MIL")
End If
SpellNumber = Replace(SpellNumber, "Millones Soles", "MILLONES DE SOLES")
SpellNumber = Replace(SpellNumber, "Millón Soles", "MILLON DE SOLES")
SpellNumber = Replace(SpellNumber, "Billones Soles", "BILLONES DE SOLES")
SpellNumber = Replace(SpellNumber, "Billón Soles", "BILLON DE SOLES")
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 MyNumber = "100" Then
Result = "CIEN "
ElseIf Mid(MyNumber, 1, 1) = "1" Then
Result = "CIENTO "
ElseIf Mid(MyNumber, 1, 1) = "5" Then
Result = "QUINIENTOS "
ElseIf Mid(MyNumber, 1, 1) = "7" Then
Result = "SETECIENTOS "
ElseIf Mid(MyNumber, 1, 1) = "9" Then
Result = "NOVECIENTOS "
ElseIf Mid(MyNumber, 1, 1) <> "0" Then
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve Ones place.
End If
GetTens = Result
End Function
Para poner el texto en mayúscula, solamente hay que añadir la linea SpellNumber = Ucase(SpellNumber) en la siguiente parte:
EliminarSpellNumber = Replace(SpellNumber, "Millones Euros", "Millones de Euros")
SpellNumber = Replace(SpellNumber, "Millón Euros", "Millón de Euros")
SpellNumber = Replace(SpellNumber, "Billones Euros", "Billones de Euros")
SpellNumber = Replace(SpellNumber, "Billón Euros", "Billón de Euros")
SpellNumber = Ucase(SpellNumber)