Conversión numero a letras

Quisiera consultarte si existe alguna función o rutina que, dado un número en una celda, me transforme ese valor a palabras (ej: 1500 -> mil quinientos) en Excel
1

1 Respuesta

21.075 pts.
Las funciones que convierten números a letras no las tiene excel por lo que hay que crearlas, copia el siguiente modulo en un editor de vb
'Funciones para convertir de números a letras
'Llamada : Letras(Número,Formato) - Formato 1-Euros
Function Unidades(num, UNO)
Dim U
Dim Cad
U = Array("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE")
Cad = ""
If num = 1 Then
Cad = Cad & "UN"
Else
Cad = Cad & U(num - 1)
End If
Unidades = Cad
End Function
Function Decenas(num1, res)
Dim D1
D1 = Array("ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", _
"DIECIOCHO", "DIECINUEVE")
d2 = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", _
"SETENTA", "OCHENTA", "NOVENTA")
If num1 Mod 10 = 0 Then
cad1 = d2(num1 / 10 - 1)
Else
If num1 > 10 And num1 < 20 Then
cad1 = D1(num1 - 10 - 1)
Else
cad1 = d2((num1 \ 10) - 1)
If (num1 \ 10) <> 2 Then
If res > 0 Then
cad1 = cad1 & " Y "
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
Else
If res <> 0 Then
cad1 = "VEINTI"
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
End If
Decenas = cad1
End Function
Function Cientos(num2)
num3 = num2 \ 100
Select Case num3
Case 1
If num2 = 100 Then
cad2 = "CIEN "
Else
cad2 = "CIENTO "
End If
Case 5
cad2 = "QUINIENTOS "
Case 7
cad2 = "SETECIENTOS "
Case 9
cad2 = "NOVECIENTOS "
Case Else
cad2 = Unidades(num3, 0) & "CIENTOS "
End Select
num2 = num2 Mod 100
If num2 > 0 Then
If num2 < 10 Then
cad2 = cad2 & Unidades(num2, num2)
Else
cad2 = cad2 & Decenas(num2, num2 Mod 10)
End If
End If
Cientos = cad2
End Function
Function Miles(num4)
If (num4 >= 100) Then
CAD3 = Cientos(num4)
Else
If (num4 >= 10) Then
CAD3 = Decenas(num4, num4 Mod 10)
Else
CAD3 = Unidades(num4, 0)
End If
End If
If CAD3 = "UN" Then
CAD3 = "MIL "
Else
CAD3 = CAD3 & " MIL "
End If
Miles = CAD3
End Function
Function Millones(cant)
If cant = 1 Then
ter = " "
Else
ter = "ES "
End If
If (cant >= 1000) Then
cantl = cantl & Miles(cant \ 1000)
cant = cant Mod 1000
End If
If cant > 0 Then
If cant >= 100 Then
cantl = cantl & Cientos(cant)
Else
If cant >= 10 Then
cantl = cantl & Decenas(cant, cant Mod 10)
Else
cantl = cantl & Unidades(cant, 0)
End If
End If
End If
Millones = cantl & " MILLON" & ter
End Function
Function decimales(numero As Single) As Integer
Dim iaux As Integer
iaux = numero - Application.Round(numero, 2)
decimales = iaux
End Function
Function letras(cantm As Variant, ByVal mon As Integer) As String
Dim cants1 As String, num1 As Variant, num2 As Variant
num1 = cantm \ 1000000
num2 = cantm - (num1 * 1000000)
cents = (num2 * 100) Mod 100
If cents = 0 Then
cents1 = "CERO"
Else
If cents > 9 Then
cents1 = Decenas(cents, 1)
Else
cents1 = Unidades(cents, UNO)
End If
End If
cantm = cantm - (cents / 100)
If cantm >= 1000000 Then
cantlm = Millones(cantm \ 1000000)
cantm = cantm Mod 1000000
End If
If cantm > 0 Then
If (cantm >= 1000) Then
cantlm = cantlm & Miles(cantm \ 1000)
cantm = cantm Mod 1000
End If
End If
If cantm > 0 Then
If cantm >= 100 Then
cantlm = cantlm & Cientos(cantm)
Else
If cantm >= 10 Then
cantlm = cantlm & Decenas(cantm, cantm Mod 10)
Else
cantlm = cantlm & Unidades(cantm, 1)
End If
End If
End If
If cantlm > 1 Then
If cantlm = "UN" Then
EU = " EURO CON "
Else
EU = " EUROS CON "
End If
If cents1 = "UN" Then
letras = cantlm & EU & cents1 & " CENTIMO"
Else
letras = cantlm & EU & cents1 & " CENTIMOS"
End If
Else
If cantlm = "UN" Then
If cents1 = "UN" Then
letras = cantlm & " EURO CON " & cents1 & " CENTIMO"
Else
letras = cantlm & " EURO CON " & cents1 & " CENTIMOS"
End If
Else
If cents1 = "UN" Then
letras = cents1 & " CENTIMO DE EURO"
Else
letras = cents1 & " CENTIMOS DE EURO"
End If
End If
End If
End Function
Una vez copiado, situate en una celda de la hoja y escribe una cantidad, en otra escribe =letras(a1;1), debería funcionar
De no ser así házmelo saber
Espero haberte sido de ayuda, no te olvides de valorar y cerrar la pregunta para poder dar paso a más preguntas incluidas las tuyas.
Conforme a lo indicado, he llevado la rutina al editor y lo reconoce en excel. Si no hay número, indica cero pesos y cero centavos (cero euros y cero céntimos) pero al ingresar un número, arroja el error #¡Valor!
solo da #¡Valor! Si en la celda a1 has introducido un carácter de texto, incluido el espacio,
con nada o con numero, aun con formato texto, general o numero, siempre da el valor en letra
¿por qué me dices lo de centavos y pesos? ¿Acaso tienes la función letras ya instalada y te da problemas? De ser así borra la anterior que puedas tener porque da problemas, no esta bien depurada
si sigues teniendo problemas ya sabesun saludo
Hola: he probado la rutina VB pero sucede:
Si anoto un valor menor que 1, por ejemplo 0,35 me muestra bien treinta y cinco céntimos pero cuando el valor es superior a 1 (1,2 100 etc.) arroja el mensaje de error. Lo que te indicaba de pesos y centavos de pesos, es porque soy de Chile y acá trabajamos con pesos y había transformado los términos de Euros a Pesos. Copié la rutina de nuevo sin modificar los euros e igualmente me da el error si el valor en A1 es 1 euro o mayor
Saludos y gracias
Te vuelvo a mandar todo:
'Funciones para convertir de números a letras
'Llamada : Letras(Número,Formato) - Formato 1-Euros
Function Unidades(num, UNO)
Dim U
Dim Cad
U = Array("UN", "DOS", "TRES", "CUATRO", "CINCO", "SEIS", "SIETE", "OCHO", "NUEVE")
Cad = ""
If num = 1 Then
Cad = Cad & "UN"
Else
Cad = Cad & U(num - 1)
End If
Unidades = Cad
End Function
Function Decenas(num1, res)
Dim D1
D1 = Array("ONCE", "DOCE", "TRECE", "CATORCE", "QUINCE", "DIECISEIS", "DIECISIETE", _
"DIECIOCHO", "DIECINUEVE")
d2 = Array("DIEZ", "VEINTE", "TREINTA", "CUARENTA", "CINCUENTA", "SESENTA", _
"SETENTA", "OCHENTA", "NOVENTA")
If num1 Mod 10 = 0 Then
cad1 = d2(num1 / 10 - 1)
Else
If num1 > 10 And num1 < 20 Then
cad1 = D1(num1 - 10 - 1)
Else
cad1 = d2((num1 \ 10) - 1)
If (num1 \ 10) <> 2 Then
If res > 0 Then
cad1 = cad1 & " Y "
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
Else
If res <> 0 Then
cad1 = "VEINTI"
cad1 = cad1 & Unidades(num1 Mod 10, 0)
End If
End If
End If
End If
Decenas = cad1
End Function
Function Cientos(num2)
num3 = num2 \ 100
Select Case num3
Case 1
If num2 = 100 Then
cad2 = "CIEN "
Else
cad2 = "CIENTO "
End If
Case 5
cad2 = "QUINIENTOS "
Case 7
cad2 = "SETECIENTOS "
Case 9
cad2 = "NOVECIENTOS "
Case Else
cad2 = Unidades(num3, 0) & "CIENTOS "
End Select
num2 = num2 Mod 100
If num2 > 0 Then
If num2 < 10 Then
cad2 = cad2 & Unidades(num2, num2)
Else
cad2 = cad2 & Decenas(num2, num2 Mod 10)
End If
End If
Cientos = cad2
End Function
Function Miles(num4)
If (num4 >= 100) Then
CAD3 = Cientos(num4)
Else
If (num4 >= 10) Then
CAD3 = Decenas(num4, num4 Mod 10)
Else
CAD3 = Unidades(num4, 0)
End If
End If
If CAD3 = "UN" Then
CAD3 = "MIL "
Else
CAD3 = CAD3 & " MIL "
End If
Miles = CAD3
End Function
Function Millones(cant)
If cant = 1 Then
ter = " "
Else
ter = "ES "
End If
If (cant >= 1000) Then
cantl = cantl & Miles(cant \ 1000)
cant = cant Mod 1000
End If
If cant > 0 Then
If cant >= 100 Then
cantl = cantl & Cientos(cant)
Else
If cant >= 10 Then
cantl = cantl & Decenas(cant, cant Mod 10)
Else
cantl = cantl & Unidades(cant, 0)
End If
End If
End If
Millones = cantl & " MILLON" & ter
End Function
Function decimales(numero As Single) As Integer
Dim iaux As Integer
iaux = numero - Application.Round(numero, 2)
decimales = iaux
End Function
Function letras(cantm As Variant, ByVal mon As Integer) As String
Dim cants1 As String, num1 As Variant, num2 As Variant
num1 = cantm \ 1000000
num2 = cantm - (num1 * 1000000)
cents = (num2 * 100) Mod 100
If cents = 0 Then
cents1 = "CERO"
Else
If cents > 9 Then
cents1 = Decenas(cents, 1)
Else
cents1 = Unidades(cents, UNO)
End If
End If
cantm = cantm - (cents / 100)
If cantm >= 1000000 Then
cantlm = Millones(cantm \ 1000000)
cantm = cantm Mod 1000000
End If
If cantm > 0 Then
If (cantm >= 1000) Then
cantlm = cantlm & Miles(cantm \ 1000)
cantm = cantm Mod 1000
End If
End If
If cantm > 0 Then
If cantm >= 100 Then
cantlm = cantlm & Cientos(cantm)
Else
If cantm >= 10 Then
cantlm = cantlm & Decenas(cantm, cantm Mod 10)
Else
cantlm = cantlm & Unidades(cantm, 1)
End If
End If
End If
If cantlm > 1 Then
If cantlm = "UN" Then
EU = " EURO CON "
Else
EU = " EUROS CON "
End If
If cents1 = "UN" Then
letras = cantlm & EU & cents1 & " CENTIMO"
Else
letras = cantlm & EU & cents1 & " CENTIMOS"
End If
Else
If cantlm = "UN" Then
If cents1 = "UN" Then
letras = cantlm & " EURO CON " & cents1 & " CENTIMO"
Else
letras = cantlm & " EURO CON " & cents1 & " CENTIMOS"
End If
Else
If cents1 = "UN" Then
letras = cents1 & " CENTIMO DE EURO"
Else
letras = cents1 & " CENTIMOS DE EURO"
End If
End If
End If
End Function
Y ademas te envío esta macro como banco de pruebas, cópiala en editor vb y ejecutala paso a paso con la ventana locales activa para ver paso a paso lo que sucede:
Sub dprueba()
Dim res As String, num As Single
num = 1.1
res = letras(num, 1)
End Sub
No entiendo porque no te funciona a mi me va de cine, salvo números negativos que no los he contemplado
Si aun así sigues teniendo problemas, mandame tu correo y te mando la hoja, a ver si así lo arreglamos, seguro que es una tontería que se nos escapa (trabajo con excel 2000, aunque no creo que sea eso)

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas