Thread View: chile.comp.programacion
4 messages
4 total messages
Started by JFG
Thu, 23 Nov 2006 17:03
Ayuda Excel
Author: JFG
Date: Thu, 23 Nov 2006 17:03
Date: Thu, 23 Nov 2006 17:03
139 lines
5225 bytes
5225 bytes
Como puedo leer un numero y dejarlo como texto en excel??
por ejemplo
si tengo en una celda con valor 100 que otra columna diga
"cien pesos"
lo �nico que encontr� fue esto, pero esta en ingles, cambi� algunas
variables en comillas, pero no me da un resultado eficiente..
saludos!!
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
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 Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
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 Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
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 = "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 ' If value between 20-99...
Select Case Val(Left(TensText, 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
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 = "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
--
El vino ahoga todas las penas, y no es chiste....
JFG
Re: Ayuda Excel
Author: Ramon Freire A.
Date: Tue, 28 Nov 2006 01:00
Date: Tue, 28 Nov 2006 01:00
310 lines
10864 bytes
10864 bytes
"Nicotinomaniaco" <NoWeeE[shelo99]@yahoo.com> escribi� en el mensaje
news:ek5j7a$3up$1@news.nivel5.cl...
> Si ese programa funciona, entonces trad�celo. Busca todos los textos que
> est�n entre comillas y cambialos por sus respectivos en espa�ol. Aun as�,
> en ingl�s los n�meros se dicen un poco diferentes de en espa�ol. Ellos
> dicen "Twenty five", nosotros "veinticinco", lo que podr�as dejar como
> "veinte y cinco". Por lo tanto, traduce "Twenty" a "Veinte y "
yo lo hice con una funcion.. qued� un poco largo pero ... es lo que hay :)
hay que pegarlo en un M�dulo de excel, tolera n�meros Enteros solamente y
ocupa 3 funciones en total
saludos
-------------------------------------------------------------------------------
Function LenMbcs(ByVal str As String)
LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function
Function gls_number(shortnumber)
'Esta funci�n entrega en palabras la cifra contenida en shortnumber, pero
esta debe ser, a lo mas
'de 3 caracteres.
'utiliza la funcion LenNMbcs para conseguir el largo ASCII de los numeros
'Made by RFA
Dim hundreds As Variant
Dim decenes1 As Variant
Dim decenes2 As Variant
Dim rest As Integer
Dim text As String
'Define arreglos para busqueda de cifras en letras
hundreds = Array("cien", "docientos", "trescientos", "cuatrocientos",
"quinientos", "seiscientos", "setecientos", "ochocientos", "novecientos")
decenes1 = Array("un", "dos", "tres", "cuatro", "cinco", "seis", "siete",
"ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince",
"diecis�is", "diecisiete", "dieciocho", "diecinueve", "veinte", "veinti�n",
"veintid�s", "veintitr�s", "veinticuatro", "veiticinco", "veintis�is",
"veintisiete", "veintiocho", "veintinueve")
decenes2 = Array("treinta", "cuarenta", "cincuenta", "sesenta", "setenta",
"ochenta", "noventa")
'Inicializa Variables
rest = shortnumber
text = ""
'Valida las centenas de la cifra ingresada
If LenMbcs(rest) = 3 Then
text = text & hundreds(Mid(rest, 1, 1) - 1)
rest = rest - Mid(rest, 1, 1) * 100
If rest > 0 Then
If shortnumber <= 199 Then
text = text & "to "
Else
text = text & " "
End If
End If
End If
'Valida el Resto del numero, una vez descontadas las centenas (dos digitos)
If LenMbcs(rest) = 2 Then
If rest <= 29 Then
If rest > 10 Then
text = text & decenes1(Mid(rest, 1, 2) - 1)
rest = rest - Mid(rest, 1, 1)
Else
text = text & decenes1(Mid(rest, 1, 2) - 1)
rest = rest - Mid(rest, 1, 1) * 10
End If
Else
text = text & decenes2(Mid(rest, 1, 1) - 3)
rest = rest - Mid(rest, 1, 1) * 10
If LenMbcs(rest) = 1 And rest > 0 Then
text = text & " y " & decenes1(Mid(rest, 1, 1) - 1)
rest = rest - Mid(rest, 1, 1)
End If
End If
End If
'Valida numeros menores o iguales a 9 (solo un digito)
If LenMbcs(rest) = 1 And rest > 0 Then
text = text & decenes1(Mid(rest, 1, 1) - 1)
rest = rest - Mid(rest, 1, 1)
End If
gls_number = text
End Function
Function num2word(number) ',measure As String)
'Convierte en palabras el numero ingresado
'Por default los n�meros son en pesos
Dim unit As Variant
Dim unit2 As Variant
Dim netvalue As Long
Dim ammount As Long
Dim lenght As Integer
Dim curr As String
If number > 2147483647 Then
num2word = "S�lo valores hasta 2,147,483,617"
Exit Function
End If
If number <> Round(number, 0) Then
num2word = "S�lo n�meros enteros"
Exit Function
End If
curr = "pesos"
If number >= 0 Then
netvalue = number
If number = 0 Then
text = "cero"
End If
Else
netvalue = -number
text = "menos"
End If
unit = Array("trill�n", "bill�n", "mill�n", "mil", "")
unit2 = Array("trillones", "billones", "millones", "mil", "")
If IsNull(number) Or number = "" Then
num2word = "ERROR: DATO NULO"
Exit Function
End If
'asigna montos
For i = 5 To 1 Step -1
largo = LenMbcs(netvalue)
If largo >= (3 * i - 2) Then
ammount = Mid(netvalue, 1, largo - 3 * (i - 1))
If ammount > 0 And LenMbcs(number) >= (3 * i + 1) Then
text = text & " "
End If
text = text & gls_number(ammount)
netvalue = netvalue - ammount * 10 ^ (3 * (i - 1))
If ammount = 1 Then
text = text & " " & unit(5 - i)
Else
text = text & " " & unit2(5 - i)
End If
End If
Next i
'define el nombre de unidades
If number <= 1 And number >= -1 Then
text = text & Mid(curr, 1, LenMbcs(curr) - 1)
Else
text = text & curr
End If
num2word = text
End Function
-------------------------------------------------------------------------------
>
> "JFG" <pidelo@pidelo.cl> escribi� en el mensaje
> news:ek4gi9$ttc$1@news.nivel5.cl...
>> Como puedo leer un numero y dejarlo como texto en excel??
>>
>> por ejemplo
>>
>> si tengo en una celda con valor 100 que otra columna diga
>>
>> "cien pesos"
>>
>> lo �nico que encontr� fue esto, pero esta en ingles, cambi� algunas
>> variables en comillas, pero no me da un resultado eficiente..
>>
>> saludos!!
>>
>>
>>
>> Option Explicit
>> 'Main Function
>> Function SpellNumber(ByVal MyNumber)
>> Dim Dollars, Cents, Temp
>> Dim DecimalPlace, Count
>> ReDim Place(9) As String
>> Place(2) = " Thousand "
>> Place(3) = " Million "
>> Place(4) = " Billion "
>> Place(5) = " Trillion "
>> ' String representation of amount.
>> MyNumber = Trim(Str(MyNumber))
>> ' Position of decimal place 0 if none.
>> 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 Dollars = Temp & Place(Count) & Dollars
>> If Len(MyNumber) > 3 Then
>> MyNumber = Left(MyNumber, Len(MyNumber) - 3)
>> Else
>> MyNumber = ""
>> End If
>> Count = Count + 1
>> Loop
>> Select Case Dollars
>> Case ""
>> Dollars = "No Dollars"
>> Case "One"
>> Dollars = "One Dollar"
>> Case Else
>> Dollars = Dollars & " Dollars"
>> End Select
>> Select Case Cents
>> Case ""
>> Cents = " and No Cents"
>> Case "One"
>> Cents = " and One Cent"
>> Case Else
>> Cents = " and " & Cents & " Cents"
>> End Select
>> SpellNumber = Dollars & Cents
>> 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 Mid(MyNumber, 1, 1) <> "0" Then
>> Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
>> 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 = "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 ' If value between 20-99...
>> Select Case Val(Left(TensText, 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
>> 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 = "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
>>
>> --
>> El vino ahoga todas las penas, y no es chiste....
>>
>> JFG
>
>
Re: Ayuda Excel
Author: Ramon Freire A.
Date: Tue, 28 Nov 2006 03:01
Date: Tue, 28 Nov 2006 03:01
319 lines
11622 bytes
11622 bytes
a todo esto la funci�n se llama num2word(<n�mero>)
saludos
"Ramon Freire A." <ramonfreire@mailcaliente.com> escribi� en el mensaje
news:ekfjkp$pcl$1@news.nivel5.cl...
> "Nicotinomaniaco" <NoWeeE[shelo99]@yahoo.com> escribi� en el mensaje
> news:ek5j7a$3up$1@news.nivel5.cl...
>> Si ese programa funciona, entonces trad�celo. Busca todos los textos que
>> est�n entre comillas y cambialos por sus respectivos en espa�ol. Aun as�,
>> en ingl�s los n�meros se dicen un poco diferentes de en espa�ol. Ellos
>> dicen "Twenty five", nosotros "veinticinco", lo que podr�as dejar como
>> "veinte y cinco". Por lo tanto, traduce "Twenty" a "Veinte y "
>
> yo lo hice con una funcion.. qued� un poco largo pero ... es lo que hay :)
> hay que pegarlo en un M�dulo de excel, tolera n�meros Enteros solamente y
> ocupa 3 funciones en total
>
> saludos
>
>
> -------------------------------------------------------------------------------
> Function LenMbcs(ByVal str As String)
> LenMbcs = LenB(StrConv(str, vbFromUnicode))
> End Function
> Function gls_number(shortnumber)
> 'Esta funci�n entrega en palabras la cifra contenida en shortnumber, pero
> esta debe ser, a lo mas
> 'de 3 caracteres.
> 'utiliza la funcion LenNMbcs para conseguir el largo ASCII de los numeros
> 'Made by RFA
>
> Dim hundreds As Variant
> Dim decenes1 As Variant
> Dim decenes2 As Variant
> Dim rest As Integer
> Dim text As String
>
> 'Define arreglos para busqueda de cifras en letras
> hundreds = Array("cien", "docientos", "trescientos", "cuatrocientos",
> "quinientos", "seiscientos", "setecientos", "ochocientos", "novecientos")
> decenes1 = Array("un", "dos", "tres", "cuatro", "cinco", "seis", "siete",
> "ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince",
> "diecis�is", "diecisiete", "dieciocho", "diecinueve", "veinte",
> "veinti�n", "veintid�s", "veintitr�s", "veinticuatro", "veiticinco",
> "veintis�is", "veintisiete", "veintiocho", "veintinueve")
> decenes2 = Array("treinta", "cuarenta", "cincuenta", "sesenta", "setenta",
> "ochenta", "noventa")
>
> 'Inicializa Variables
> rest = shortnumber
> text = ""
>
> 'Valida las centenas de la cifra ingresada
> If LenMbcs(rest) = 3 Then
> text = text & hundreds(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1) * 100
> If rest > 0 Then
> If shortnumber <= 199 Then
> text = text & "to "
> Else
> text = text & " "
> End If
> End If
> End If
>
> 'Valida el Resto del numero, una vez descontadas las centenas (dos
> digitos)
> If LenMbcs(rest) = 2 Then
> If rest <= 29 Then
> If rest > 10 Then
> text = text & decenes1(Mid(rest, 1, 2) - 1)
> rest = rest - Mid(rest, 1, 1)
> Else
> text = text & decenes1(Mid(rest, 1, 2) - 1)
> rest = rest - Mid(rest, 1, 1) * 10
> End If
> Else
> text = text & decenes2(Mid(rest, 1, 1) - 3)
> rest = rest - Mid(rest, 1, 1) * 10
> If LenMbcs(rest) = 1 And rest > 0 Then
> text = text & " y " & decenes1(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1)
> End If
> End If
> End If
>
> 'Valida numeros menores o iguales a 9 (solo un digito)
> If LenMbcs(rest) = 1 And rest > 0 Then
> text = text & decenes1(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1)
> End If
>
> gls_number = text
>
> End Function
> Function num2word(number) ',measure As String)
> 'Convierte en palabras el numero ingresado
> 'Por default los n�meros son en pesos
>
> Dim unit As Variant
> Dim unit2 As Variant
> Dim netvalue As Long
> Dim ammount As Long
> Dim lenght As Integer
> Dim curr As String
>
> If number > 2147483647 Then
> num2word = "S�lo valores hasta 2,147,483,617"
> Exit Function
> End If
>
> If number <> Round(number, 0) Then
> num2word = "S�lo n�meros enteros"
> Exit Function
> End If
>
> curr = "pesos"
>
> If number >= 0 Then
> netvalue = number
> If number = 0 Then
> text = "cero"
> End If
> Else
> netvalue = -number
> text = "menos"
> End If
>
> unit = Array("trill�n", "bill�n", "mill�n", "mil", "")
> unit2 = Array("trillones", "billones", "millones", "mil", "")
>
> If IsNull(number) Or number = "" Then
> num2word = "ERROR: DATO NULO"
> Exit Function
> End If
>
> 'asigna montos
> For i = 5 To 1 Step -1
> largo = LenMbcs(netvalue)
> If largo >= (3 * i - 2) Then
> ammount = Mid(netvalue, 1, largo - 3 * (i - 1))
> If ammount > 0 And LenMbcs(number) >= (3 * i + 1) Then
> text = text & " "
> End If
> text = text & gls_number(ammount)
> netvalue = netvalue - ammount * 10 ^ (3 * (i - 1))
> If ammount = 1 Then
> text = text & " " & unit(5 - i)
> Else
> text = text & " " & unit2(5 - i)
> End If
> End If
> Next i
>
> 'define el nombre de unidades
> If number <= 1 And number >= -1 Then
> text = text & Mid(curr, 1, LenMbcs(curr) - 1)
> Else
> text = text & curr
> End If
>
> num2word = text
>
> End Function
> -------------------------------------------------------------------------------
>
>
>
>
>
>
>
>>
>> "JFG" <pidelo@pidelo.cl> escribi� en el mensaje
>> news:ek4gi9$ttc$1@news.nivel5.cl...
>>> Como puedo leer un numero y dejarlo como texto en excel??
>>>
>>> por ejemplo
>>>
>>> si tengo en una celda con valor 100 que otra columna diga
>>>
>>> "cien pesos"
>>>
>>> lo �nico que encontr� fue esto, pero esta en ingles, cambi� algunas
>>> variables en comillas, pero no me da un resultado eficiente..
>>>
>>> saludos!!
>>>
>>>
>>>
>>> Option Explicit
>>> 'Main Function
>>> Function SpellNumber(ByVal MyNumber)
>>> Dim Dollars, Cents, Temp
>>> Dim DecimalPlace, Count
>>> ReDim Place(9) As String
>>> Place(2) = " Thousand "
>>> Place(3) = " Million "
>>> Place(4) = " Billion "
>>> Place(5) = " Trillion "
>>> ' String representation of amount.
>>> MyNumber = Trim(Str(MyNumber))
>>> ' Position of decimal place 0 if none.
>>> 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 Dollars = Temp & Place(Count) & Dollars
>>> If Len(MyNumber) > 3 Then
>>> MyNumber = Left(MyNumber, Len(MyNumber) - 3)
>>> Else
>>> MyNumber = ""
>>> End If
>>> Count = Count + 1
>>> Loop
>>> Select Case Dollars
>>> Case ""
>>> Dollars = "No Dollars"
>>> Case "One"
>>> Dollars = "One Dollar"
>>> Case Else
>>> Dollars = Dollars & " Dollars"
>>> End Select
>>> Select Case Cents
>>> Case ""
>>> Cents = " and No Cents"
>>> Case "One"
>>> Cents = " and One Cent"
>>> Case Else
>>> Cents = " and " & Cents & " Cents"
>>> End Select
>>> SpellNumber = Dollars & Cents
>>> 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 Mid(MyNumber, 1, 1) <> "0" Then
>>> Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
>>> 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 = "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 ' If value between 20-99...
>>> Select Case Val(Left(TensText, 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
>>> 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 = "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
>>>
>>> --
>>> El vino ahoga todas las penas, y no es chiste....
>>>
>>> JFG
>>
>>
>
>
Re: Ayuda Excel
Author: Ramon Freire A.
Date: Tue, 28 Nov 2006 03:02
Date: Tue, 28 Nov 2006 03:02
319 lines
11622 bytes
11622 bytes
a todo esto la funci�n se llama num2word(<n�mero>)
saludos
"Ramon Freire A." <ramonfreire@mailcaliente.com> escribi� en el mensaje
news:ekfjkp$pcl$1@news.nivel5.cl...
> "Nicotinomaniaco" <NoWeeE[shelo99]@yahoo.com> escribi� en el mensaje
> news:ek5j7a$3up$1@news.nivel5.cl...
>> Si ese programa funciona, entonces trad�celo. Busca todos los textos que
>> est�n entre comillas y cambialos por sus respectivos en espa�ol. Aun as�,
>> en ingl�s los n�meros se dicen un poco diferentes de en espa�ol. Ellos
>> dicen "Twenty five", nosotros "veinticinco", lo que podr�as dejar como
>> "veinte y cinco". Por lo tanto, traduce "Twenty" a "Veinte y "
>
> yo lo hice con una funcion.. qued� un poco largo pero ... es lo que hay :)
> hay que pegarlo en un M�dulo de excel, tolera n�meros Enteros solamente y
> ocupa 3 funciones en total
>
> saludos
>
>
> -------------------------------------------------------------------------------
> Function LenMbcs(ByVal str As String)
> LenMbcs = LenB(StrConv(str, vbFromUnicode))
> End Function
> Function gls_number(shortnumber)
> 'Esta funci�n entrega en palabras la cifra contenida en shortnumber, pero
> esta debe ser, a lo mas
> 'de 3 caracteres.
> 'utiliza la funcion LenNMbcs para conseguir el largo ASCII de los numeros
> 'Made by RFA
>
> Dim hundreds As Variant
> Dim decenes1 As Variant
> Dim decenes2 As Variant
> Dim rest As Integer
> Dim text As String
>
> 'Define arreglos para busqueda de cifras en letras
> hundreds = Array("cien", "docientos", "trescientos", "cuatrocientos",
> "quinientos", "seiscientos", "setecientos", "ochocientos", "novecientos")
> decenes1 = Array("un", "dos", "tres", "cuatro", "cinco", "seis", "siete",
> "ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince",
> "diecis�is", "diecisiete", "dieciocho", "diecinueve", "veinte",
> "veinti�n", "veintid�s", "veintitr�s", "veinticuatro", "veiticinco",
> "veintis�is", "veintisiete", "veintiocho", "veintinueve")
> decenes2 = Array("treinta", "cuarenta", "cincuenta", "sesenta", "setenta",
> "ochenta", "noventa")
>
> 'Inicializa Variables
> rest = shortnumber
> text = ""
>
> 'Valida las centenas de la cifra ingresada
> If LenMbcs(rest) = 3 Then
> text = text & hundreds(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1) * 100
> If rest > 0 Then
> If shortnumber <= 199 Then
> text = text & "to "
> Else
> text = text & " "
> End If
> End If
> End If
>
> 'Valida el Resto del numero, una vez descontadas las centenas (dos
> digitos)
> If LenMbcs(rest) = 2 Then
> If rest <= 29 Then
> If rest > 10 Then
> text = text & decenes1(Mid(rest, 1, 2) - 1)
> rest = rest - Mid(rest, 1, 1)
> Else
> text = text & decenes1(Mid(rest, 1, 2) - 1)
> rest = rest - Mid(rest, 1, 1) * 10
> End If
> Else
> text = text & decenes2(Mid(rest, 1, 1) - 3)
> rest = rest - Mid(rest, 1, 1) * 10
> If LenMbcs(rest) = 1 And rest > 0 Then
> text = text & " y " & decenes1(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1)
> End If
> End If
> End If
>
> 'Valida numeros menores o iguales a 9 (solo un digito)
> If LenMbcs(rest) = 1 And rest > 0 Then
> text = text & decenes1(Mid(rest, 1, 1) - 1)
> rest = rest - Mid(rest, 1, 1)
> End If
>
> gls_number = text
>
> End Function
> Function num2word(number) ',measure As String)
> 'Convierte en palabras el numero ingresado
> 'Por default los n�meros son en pesos
>
> Dim unit As Variant
> Dim unit2 As Variant
> Dim netvalue As Long
> Dim ammount As Long
> Dim lenght As Integer
> Dim curr As String
>
> If number > 2147483647 Then
> num2word = "S�lo valores hasta 2,147,483,617"
> Exit Function
> End If
>
> If number <> Round(number, 0) Then
> num2word = "S�lo n�meros enteros"
> Exit Function
> End If
>
> curr = "pesos"
>
> If number >= 0 Then
> netvalue = number
> If number = 0 Then
> text = "cero"
> End If
> Else
> netvalue = -number
> text = "menos"
> End If
>
> unit = Array("trill�n", "bill�n", "mill�n", "mil", "")
> unit2 = Array("trillones", "billones", "millones", "mil", "")
>
> If IsNull(number) Or number = "" Then
> num2word = "ERROR: DATO NULO"
> Exit Function
> End If
>
> 'asigna montos
> For i = 5 To 1 Step -1
> largo = LenMbcs(netvalue)
> If largo >= (3 * i - 2) Then
> ammount = Mid(netvalue, 1, largo - 3 * (i - 1))
> If ammount > 0 And LenMbcs(number) >= (3 * i + 1) Then
> text = text & " "
> End If
> text = text & gls_number(ammount)
> netvalue = netvalue - ammount * 10 ^ (3 * (i - 1))
> If ammount = 1 Then
> text = text & " " & unit(5 - i)
> Else
> text = text & " " & unit2(5 - i)
> End If
> End If
> Next i
>
> 'define el nombre de unidades
> If number <= 1 And number >= -1 Then
> text = text & Mid(curr, 1, LenMbcs(curr) - 1)
> Else
> text = text & curr
> End If
>
> num2word = text
>
> End Function
> -------------------------------------------------------------------------------
>
>
>
>
>
>
>
>>
>> "JFG" <pidelo@pidelo.cl> escribi� en el mensaje
>> news:ek4gi9$ttc$1@news.nivel5.cl...
>>> Como puedo leer un numero y dejarlo como texto en excel??
>>>
>>> por ejemplo
>>>
>>> si tengo en una celda con valor 100 que otra columna diga
>>>
>>> "cien pesos"
>>>
>>> lo �nico que encontr� fue esto, pero esta en ingles, cambi� algunas
>>> variables en comillas, pero no me da un resultado eficiente..
>>>
>>> saludos!!
>>>
>>>
>>>
>>> Option Explicit
>>> 'Main Function
>>> Function SpellNumber(ByVal MyNumber)
>>> Dim Dollars, Cents, Temp
>>> Dim DecimalPlace, Count
>>> ReDim Place(9) As String
>>> Place(2) = " Thousand "
>>> Place(3) = " Million "
>>> Place(4) = " Billion "
>>> Place(5) = " Trillion "
>>> ' String representation of amount.
>>> MyNumber = Trim(Str(MyNumber))
>>> ' Position of decimal place 0 if none.
>>> 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 Dollars = Temp & Place(Count) & Dollars
>>> If Len(MyNumber) > 3 Then
>>> MyNumber = Left(MyNumber, Len(MyNumber) - 3)
>>> Else
>>> MyNumber = ""
>>> End If
>>> Count = Count + 1
>>> Loop
>>> Select Case Dollars
>>> Case ""
>>> Dollars = "No Dollars"
>>> Case "One"
>>> Dollars = "One Dollar"
>>> Case Else
>>> Dollars = Dollars & " Dollars"
>>> End Select
>>> Select Case Cents
>>> Case ""
>>> Cents = " and No Cents"
>>> Case "One"
>>> Cents = " and One Cent"
>>> Case Else
>>> Cents = " and " & Cents & " Cents"
>>> End Select
>>> SpellNumber = Dollars & Cents
>>> 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 Mid(MyNumber, 1, 1) <> "0" Then
>>> Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
>>> 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 = "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 ' If value between 20-99...
>>> Select Case Val(Left(TensText, 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
>>> 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 = "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
>>>
>>> --
>>> El vino ahoga todas las penas, y no es chiste....
>>>
>>> JFG
>>
>>
>
>
Thread Navigation
This is a paginated view of messages in the thread with full content displayed inline.
Messages are displayed in chronological order, with the original post highlighted in green.
Use pagination controls to navigate through all messages in large threads.
Back to All Threads