A raíz de una consulta solucionada me he inspirado para resolver ecuaciones de una incógnita sin el complemento Solver

[DBOX]https://www.ayudaexcel.com/foro/macros-programacion-vba-10/codigo-para-resolver-ecuacion-recursiva-29835/[/DBOX]

Pasos a seguir:

1. Escribe la precisión a alcanzar en la celda B2, ejemplo: 0,0000000000001
   
2. Escribe la fórmula a ReSolver en una celda de la columna G y la verás escrita en la columna F por arte de magia.
   
3. Escribe el resultado de la igualdad de la fórmula en la columna E.
   
4. Escribe un primer valor de la incógnita (semilla) en la columna D que no provoque error en la fórmula a ReSolver.
   
5. Selecciona la celda de la columna G con la fórmula.
   
6. Presiona el botón "ReSolver". Si se atasca la solución, pulsa la tecla Escape - Esc
   
7. En la celda de la columna D esta el valor obtenido de la incógnita.
   
8. En la columna H se informa del número de iteraciones precisas para ReSolver la ecuación.
   

Espero que sea más intuitiva y más veloz que la consabida Solver.

¡Y sin necesidad de instalar complementos! :playful:

P.D.: Tengo que dar las gracias a Macro Antonio, sin su colaboración no se me hubiera ocurrido dedicarme a ésto.

MacroSolver-PW1.xls

Debido al éxito de este tema (dicho con ironía) adjunto una nueva versión para ReSolver algunos problemas de la anterior, como el continuar buscando una solución para la incógnita cuando la fórmula devuelve error o si no se ha elegido la semilla adecuada, poder dar marcha atrás en los valores de la incógnita.

Se ha complicado un poco más de lo que esperaba pero con las fórmulas de ejemplo funciona como se espera.

Observa que la fórmula de la fila 5 tiene dos soluciones, lo que se consigue ejecutando dos veces ReSolver.

[TABLE=width: 450]

[TR]

[TD=align: right]0[/TD]

[TD]=D5^2+3*D5[/TD]

[/TR]

[/TABLE]

Si tienes una fórmula con la que no funciona, me lo dices contestando a este mensaje.

Macro Antonio, me alegra que te guste este tema.

MacroSolver-PW2.xls

Para todos los interesados (que se que son muchos), adjunto comparación entre mi macro para ReSolver ecuaciones con una incógnita y los resultados con el complemento Solver y con la función Buscar objetivo... ordenados de menor a mayor precisión.

[ATTACH]39780.vB[/ATTACH]

[TABLE=width: 433]

[TR]

[TD]Solución con:[/TD]

[TD]Diámetro: D [m][/TD]

[TD]Fórmula(D)[/TD]

[/TR]

[TR]

[TD]Buscar objetivo…[/TD]

[TD=align: right]0,429741276396771[/TD]

[TD=align: right]-0,000245170165800[/TD]

[/TR]

[TR]

[TD]Solver[/TD]

[TD=align: right]0,429741795343311[/TD]

[TD=align: right]0,000000350027651[/TD]

[/TR]

[TR]

[TD]Macro ReSolver[/TD]

[TD=align: right]0,429741794603468[/TD]

[TD=align: right]-0,000000000000044[/TD]

[/TR]

[/TABLE]

MacroSolver-PW2.1.xls

Hola Pedro:

Me alegra ver que tus aportes son tan valorados como los míos.

Me consta que Rajoy, Montoro, ...y demás mentes privilegiadas de este país están usando tu aporte para solucionar su ecuación

Disminución paro = Inversión * Imaginación * Ganas de hacerlo

pero no les sale, échales una mano,....jajaja

No te desanimes, sigue con tus aportes, que al menos yo, me los leo.

Saludos

Hola Macro Antonio, ¡que voy a desanimarme!

¡Si hasta los romanos leen mis mensajes desde Uganda!

Si tienes contactos en esferas tan altas como para que te conste que me leen (esas mentes privilegiadas por el lugar que ocupan que no portentosas, que para eso hay que valer), ¡ya me pasarás esos contactos por si me pueden sacar de alguna crisis!

O acaso, ¿es que esos Rajoy y Montoro son patricios del senado romano como tú y como tu tío Julio César?

Ya sabes que no estoy muy puesto en historia romana.

Me he informado en la resabiada Wikipedia de que los patricios mantenéis el derecho privado:

• Ius Commerci: o derecho de realizar toda clase de negocio jurídico público y sobre todo privado;
  

¡¡¡ Y así nos va a los plebeyos !!!

Como se lee en la consabida Wikipedia:

Estas gentes no patricias se vieran marginadas y carecieran de ciertos derechos civiles (por ejemplo carecían de derecho a votar), fue causa de múltiples enfrentamientos patricios-plebeyos.

Pues para que lo sepas patricio Macro Antonio, ¡yo me considero plebeyo, a mucha honra!

¡¡¡ Nos veremos las caras macro-formulianas !!!

Disminución paro = Inversión * Imaginación * Ganas de hacerlo * Quitar inútiles de la pública y la privada * Valorar experiencia de los > 50 años * Valorar potencial de los jóvenes excelentemente preparados

P.D.: La macro para resolver esas n-mil incógnitas económicas con tu fórmula la dejo en tus manos.

¡ No te las laves como Pontius Pilatus !

Hola Pedro, no te desanimes, para mi es un excelente aporte, apenas estoy utilizando solver (después de llevar años usando excel, jijiji), y veo que es muy interesante y entretenido, y con tus archivos veré como sacarle mas provecho al excel.

Saludos.

Hola amigos, soy novato en macros y necesito ayuda!!!, ¡¿Cómo puedo despejar la variable (Sigma sd0.01) de la ecuación que adjunto si fyd es un valor conocido?, les agradezco de antemano por sus sugerencias, saludos..

Te dejo esta función, pero no tengo claro si es esto lo que quieres.

Pon la función en un modulo y úsala como fórmula en la hoja.

=Sigma(Celda)

Function Sigma(ByVal fyd As Double) As Double


Do Until Resultado > 0.00999

  Sigma = Sigma + 0.001

  Resultado = (Sigma / 200000) + (0.823 * ((Sigma / fyd) - 0.7) ^ 5)

Loop


End Function

[/CODE]

[/color]

[/b]

Hola, estoy iniciando en esto de los macros y quiero hacer una funcion que resuelva esta ecuacion:

Que me devuelva el valor de "Y" ingresando "Q, S, B, N"

Gracias

Te dejo esta función, pero no tengo claro si es esto lo que quieres.

Pon la función en un modulo y úsala como fórmula en la hoja.

=Sigma(Celda)

Function Sigma(ByVal fyd As Double) As Double


Do Until Resultado > 0.00999

  Sigma = Sigma + 0.001

  Resultado = (Sigma / 200000) + (0.823 * ((Sigma / fyd) - 0.7) ^ 5)

Loop


End Function

[/CODE]

[/color][/b]

.

Pon en un módulo la siguiente UDF:

Function CALCULAR_Y(ByVal Q As Range, _

                    ByVal S As Range, _

                    ByVal B As Range, _

                    ByVal N As Range)

Do Until Not Valor < Q

  y = y + 0.001

  W1 = S ^ 0.5

  W2 = (y *  ^ (5 / 3)

  W3 = N * ((B + 2 * y) ^ (2 / 3))

  Valor = W1 * W2 / W3

Loop

CALCULAR_Y = y

End Function

[/CODE]

[u]Fórmula[/u]:

[b]=CALCULAR_Y([/b][i][color=#0000ff]Celda[b]Q[/b];Celda[b]S[/b];Celda[b]B[/b];Celda[b]N[/b][/color][/i][b])

.[/b]

Muchas gracias por reponder tan rapido.... Solo funciona cuando jala valores de otras celdas no? pero me sirve de maravilla!

Si pudieras explicar el funcionamiento del codigo seria genial!

.

Pon en un módulo la siguiente UDF:

Function CALCULAR_Y(ByVal Q As Range, _

                    ByVal S As Range, _

                    ByVal B As Range, _

                    ByVal N As Range)

Do Until Not Valor < Q

  y = y + 0.001

  W1 = S ^ 0.5

  W2 = (y *  ^ (5 / 3)

  W3 = N * ((B + 2 * y) ^ (2 / 3))

  Valor = W1 * W2 / W3

Loop

CALCULAR_Y = y

End Function

[/CODE]

[u]Fórmula[/u]:

[b]=CALCULAR_Y([/b][i][color=#0000ff]Celda[b]Q[/b];Celda[b]S[/b];Celda[b]B[/b];Celda[b]N[/b][/color][/i][b])

.[/b]

Tal como está la función espera recibir los valores desde 4 celdas.

Se trata de un proceso iterativo desde y=0 incrementando 0,001 en cada iteración hasta encontrar un resultado igual o mayor que Q.

Hola Macro Antonio, hice una variacion a la ecuacion que te envie anteriormente, y ahora no sale.... imagino que sera por que estoy usando funciones trigonometricas aunque señala error en la letra "D", podrias ayudarme?

Gracias de antemano!

Tal como está la función espera recibir los valores desde 4 celdas.

Se trata de un proceso iterativo desde y=0 incrementando 0,001 en cada iteración hasta encontrar un resultado igual o mayor que Q.

Con una imagen no hacemos nada, sube el archivo.

Este es el archivo, gracias.

Con una imagen no hacemos nada, sube el archivo.

Calculo Y.zip

Tienes dos problemas, uno fácil de resolver, tenías funciones no reconocidas, el otro es producido por un cambio de tendencia en la iteración 938, es decir el valor obtenido es inferior al valor anterior, por lo que jamás llegará al valor propuesto entrando en un bucle sin fin, con objeto de evitar esta situación Excel se protege dando error en la función.

Function TIRANTE_CIRCULAR(ByVal Q As Range, _

                    ByVal D As Range, _

                    ByVal S As Range, _

                    ByVal N As Range)

Do Until Not valor < Q

  Y = Y + 0.001

  TETA = 2 * WorksheetFunction.Acos(1 - 2 * Y / D)

  A = (D ^ 2 / 8) * (TETA - Sin(TETA))

  P = TETA * D / 2

  valor = S ^ 0.5 / N * A ^ (5 / 3) / P ^ (2 / 3)

  c = c + 1

Loop

TIRANTE_CIRCULAR = Y


'cambio de tendencia en el ciclo 938

  '937  0,749713089427675

  '938  0,749709522074945


End Function

[/CODE]