Crear funcion personalizada

23/05/2005 - 00:16 por Javi | Informe spam

Hola

Estoy intentando hacer una funcion personalizada para un descuento un
poco especial, del tipo 30%+15% o para el normal del 25%

KL ya me dió una idea para pasarlo a un formulario, pero quiero
utilizarlo también en una celda de una hoja y no hay manera de que funcione.

Lo que he escrito es esto:

Function descuentounico(celda)
texto = celda
If InStr(texto, "+") Then
txt1 = Left(texto, InStr(texto, "+") - 2)
'solo toma el número sin %
largo = Len(texto)
txt2 = Mid(texto, InStr(texto, "+") + 1, largo-1)
'solo toma el número sin %
Else
txt1 = texto
txt2 = ""
End If
dcto1 = CCur(txt1)
dcto2 = CCur(txt2)
descuentounico = Round ( dcto1 + dcto2 - dcto1 * dcto2 / 100, 2)

End Function

La función hará referencia a la celda que contenga el descuento, por
ejemplo si está en la celda F8 y en la F7 está el descuento (por ejemplo
el 40%+10%), la Žcelda contendría
=descuentounico(F7)

pero me da el error #VALOR

Como siempre gracias

Javi

Siga el debate

3 respuestas

Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#1 KL

23/05/2005 - 01:03 | Informe spam

Hola Javi,

Prueba el siguiente codigo.

Saludos,
KL

Function descuentounico(Celda As Range)
Application.Volatile
Dim dcto1 As Double
Dim dcto2 As Double
If InStr(Celda, "+") Then
dcto1 = Format(Left(Celda, InStr(Celda, "+") - _
1), "0.00")
dcto2 = Format(Mid(Celda, InStr(Celda, "+") + _
1, Len(Celda)), "0.00")
Else
dcto1 = Celda
dcto2 = 0
End If
descuentounico = Round(1 - (1 - dcto1) * (1 - _
dcto2), 2)
End Function

Responder a este mensaje

#2 Luis Garcia

23/05/2005 - 11:03 | Informe spam

"Javi" escribió en...

Hola

Estoy intentando hacer una funcion personalizada para un descuento un
poco especial, del tipo 30%+15% o para el normal del 25%

''' Para que te permita desde 1 hasta <n> descuentos:

Public Function DescuentoUnico(Celda As Range) As Double
Dim aDsc As Variant
Dim nDsc As Integer

On Error Goto ErrFunction
aDsc = Split(Celda.Value, "+")
DescuentoUnico = 1
For nDsc = 0 To UBound(aDsc)
If Right$(Trim$(aDsc(nDsc)), 1) = "%" Then aDsc(nDsc) Val(aDsc(nDsc)) / 100
DescuentoUnico = DescuentoUnico * (1 - aDsc(nDsc))
Next nDsc
Exit Function
ErrFunction:
DescuentoUnico = 1
End Function

Responder a este mensaje

#3 Javi

30/05/2005 - 01:01 | Informe spam

Hola a los dos

Muchas gracias por vuestras respuestas, ya está funcionando. Me ha
resultado más sencilla de entender la opción de KL, pero me han enseñado
mucho las dos opciones.

Muchas gracias (aunque un poco tarde)

Javi

Luis Garcia escribió:

"Javi" escribió en...

Hola

Estoy intentando hacer una funcion personalizada para un descuento un
poco especial, del tipo 30%+15% o para el normal del 25%

''' Para que te permita desde 1 hasta <n> descuentos:

Public Function DescuentoUnico(Celda As Range) As Double
Dim aDsc As Variant
Dim nDsc As Integer

On Error Goto ErrFunction
aDsc = Split(Celda.Value, "+")
DescuentoUnico = 1
For nDsc = 0 To UBound(aDsc)
If Right$(Trim$(aDsc(nDsc)), 1) = "%" Then aDsc(nDsc) > Val(aDsc(nDsc)) / 100
DescuentoUnico = DescuentoUnico * (1 - aDsc(nDsc))
Next nDsc
Exit Function
ErrFunction:
DescuentoUnico = 1
End Function

Siga el debate Respuesta

Responder a este mensaje

Ads by Google

Hacer una pregunta

Tengo una respuesta

Busqueda sugerida