Jump to content

Macro con Select Case


Recommended Posts

hola espero me puedan ayudar, mi pregunta es la siguente tengo una funcion que se basa en una matriz para realizar una interpolacion pero necesito que cuando la celda H5 cambie su valor eliga un Case y defina la matriz de rango a evaluar para que la funcion quede unicamente asi

=lagrange(F10) en vez de =Lagrange(F10,$P$20:$Q$25)

osea que la matriz

$P$20:$Q$25

La tome como un rango en el case cuando valga "3/4"

r3ocas.zip

Link to comment
Share on other sites

Hola Jose,

te propongo que el parámetro "Mi" sea opcional:

Function Lagrange(x1 As Double, Optional Mi As Range) [COLOR=#008000]'rango opcional[/COLOR]

Dim valorX As Double
Dim n, i, j As Integer
Dim x() As Double
Dim y() As Double
Dim W, suma As Double

If Mi Is Nothing Then Set Mi = Range("$P$20:$Q$25")[COLOR=#008000] 'si no se especifica el rango, va por omisión[/COLOR]
n = Mi.Rows.Count

ReDim x(n)
ReDim y(n)


valorX = x1
suma = 0

For i = 1 To n
x(i) = Mi(i, 1)
y(i) = Mi(i, 2)
Next i

For j = 1 To n
W = y(j)
For i = 1 To n
If j <> i Then
W = W * (valorX - x(i)) / (x(j) - x(i))
End If
Next i
suma = suma + W
Next j
Lagrange = suma


End Function[/CODE]

Así podés escribir la función

[CODE][COLOR=#333333]=lagrange(F10)[/COLOR][/CODE]

[color=#333333] o [/color]

[CODE][COLOR=#333333]=Lagrange(F10,$P$20:$Q$25)[/COLOR][/CODE]

[color=#333333]

indistintamente.[/color]

Link to comment
Share on other sites

Gracias amigo es una buena solucion pero por ejemplo que tuviera diferentes rangos para evaluar y que se buscara cada rango del 1 al 6 y que si pongo un 2 en la celda H5 me lo haga con un rango de P30:Q35 y si fuera 1 lo haga con p20:q25.....

Link to comment
Share on other sites

hola mira la condicion debe ser asi, cuando $H$5 sea igual a "3/8" tome el rango de $P$20:$Q$25 y para cuaduando $H$5 sea igual a "1/2"tome el rango $P$30:$Q$35)y asi susecivamente para varias condiciones.

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.

×
×
  • Create New...

Important Information

Privacy Policy