Jump to content
soda1206

macro para automatizar proceso simple "Resolver ecuaciones con Buscar Objetivo"

Recommended Posts

Hola foreros, espero que me puedan ayudarme, tengo un código el cual quisiera automatizar (código vb pegado al final de este mensaje), ya que son más de 2.000 registros y hacerlo 1 a 1 es de locos, la verdad que no sé como hacer para que este código grabado se realice fila a fila...empezando de la siguiente manera: voy a columna AG y coloco 1 en la celda a calcular (en este ejemplo voy en celda AG 8) y en celda adyacente (celda AH 8) coloco 70, luego voy al complemento SOLVER y elijo celda objetivo que es celda AQ 8, y cambiando las celdas de variables AG8:AH8 y sujeto a las restricciones dadas en AH8 <= 100 y AH8>=AB8 y "RESOLVER" para que realice cálculo. en el fondo quiero que este cálculo que se ve en el código grabado, vaya avanzando fila a fila. Espero haberme explicado en algo y adjunto archivo ejemplo a través de google drive por que no dejó subir el archivo al sitio.

https://drive.google.com/file/d/1uu_X93JQcucIhV5mUkTiwJvSuFDiVZTy/view?usp=sharing

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("AG5").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("AH5").Select
    ActiveCell.FormulaR1C1 = "70"
    Range("AQ5").Select
    SolverAceptar definirCelda:="$AQ$5", valorMáxMín:=3, valorDe:="0", _
        celdasCambiantes:="$AG$5:$AH$5"
    SolverEliminar referenciaCelda:="$AH$21", relación:=1, Formula:="100"
    SolverAgregar referenciaCelda:="$AH$5", relación:=1, Formula:="100"
    SolverAceptar definirCelda:="$AQ$5", valorMáxMín:=3, valorDe:="0", _
        celdasCambiantes:="$AG$5:$AH$5"
    SolverEliminar referenciaCelda:="$AH$4", relación:=3, Formula:="$AB$4"
    SolverAgregar referenciaCelda:="$AH$5", relación:=3, Formula:="$AB$5"""
    SolverAceptar definirCelda:="$AQ$5", valorMáxMín:=3, valorDe:="0", _
        celdasCambiantes:="$AG$5:$AH$5"
    SolverResolver
End Sub

Share this post


Link to post
Share on other sites

¡Hola, @soda1206!

En primera instancia, para que el código funcione, debes prender la referencia Solver en el VBE (Editor de Visual Basic para Aplicaciones).  Para hacerlo, vas al Menú Herramientas, Referencias, y buscas Solver (el cual debe prenderse).

Una vez hecho esto, puedes usar el siguente código:

Sub SolverRango()
    Dim i&
    Application.ScreenUpdating = False
    For i = 4 To 33
        Range("AG" & i).Resize(, 2) = Array(1, 70)
        SolverOk SetCell:="$AQ$" & i, MaxMinVal:=3, ValueOf:=0, ByChange:="$AG$" & i & ":$AH$" & i, _
            Engine:=1, EngineDesc:="GRG Nonlinear"
        SolverSolve True
    Next i
    Application.ScreenUpdating = True
End Sub

¡Bendiciones!

Share this post


Link to post
Share on other sites

¡Hola, @soda1206!

Si ya prendiste la referencia Solver... prueba cambiando el código a español, así:

Sub SolverRango()
    Dim i&
    Application.ScreenUpdating = False
    For i = 4 To 33
        Range("AG" & i).Resize(, 2) = Array(1, 70)
        SolverAceptar "$AQ$" & i, 3, 0, "$AG$" & i & ":$AH$" & i, 1, "GRG Nonlinear"
        SolverResolver True
    Next i
    Application.ScreenUpdating = True
End Sub

y nos cuentas.  ¡Bendiciones!

Share this post


Link to post
Share on other sites

Hola de nuevo, @soda1206.

¿Estás seguro que hiciste esto?

Hace 1 hora, johnmpl dijo:

debes prender la referencia Solver en el VBE (Editor de Visual Basic para Aplicaciones).  Para hacerlo, vas al Menú Herramientas, Referencias, y buscas Solver (el cual debe prenderse).

¡Ojo! no es lo mismo habilitar el complemento Solver para Excel que prender la referencia Solver en el VBE (por si estás pensando esto).  ¡Bendiciones!

Img1.thumb.jpg.ed2e847f231d2059b54837f7fbfe3345.jpg

img2.thumb.jpg.e7f2ccd9e1899e7aa68f2da0c58eb52d.jpg

Share this post


Link to post
Share on other sites

estimado @johnmpl efectivamente no había tachado el box de solver, ahora se ejecuta, pero le faltó estas restricciones  que están en la macro grabada que te mostré inicialmente y en tu código las agregué de esta forma:

 SolverAdd CellRef:="$AH$" & i, Relation:=1, FormulaText:="100" (columna AH sea <= 100)
 SolverAdd CellRef:="$AH$" & i, Relation:=3, FormulaText:="$AB$" & i   (columna AH sea >= que columna AB)  

y lo que me está faltando es que si la columna AG y/o Columna AH tienen valor -1 que las deje tal cual...con ese valor -1, que no calcule nada.

este es el código que tengo hasta el momento, falta decirle que si detecta en la columna AG y/o columna AH el valor -1, no realice modificaciones, código:

Sub SolverRango()
    Dim i&
    Application.ScreenUpdating = False
    For i = 4 To 5
        Range("AG" & i).Resize(, 2) = Array(1, 70)
        SolverOk SetCell:="$AQ$" & i, MaxMinVal:=3, ValueOf:=0, ByChange:="$AG$" & i & ":$AH$" & i, _
            Engine:=1, EngineDesc:="GRG Nonlinear"
    
        SolverAdd CellRef:="$AH$" & i, Relation:=1, FormulaText:="100"
        SolverAdd CellRef:="$AH$" & i, Relation:=3, FormulaText:="$AB$" & i
        
        SolverOk SetCell:="$AQ$" & i, MaxMinVal:=3, ValueOf:=0, ByChange:="$AG$" & i & ":$AH$" & i, _
            Engine:=1, EngineDesc:="GRG Nonlinear"
        
        SolverSolve True
    Next i
    Application.ScreenUpdating = True
End Sub

 

Edited by johnmpl
Envolver código en etiquetas

Share this post


Link to post
Share on other sites

Ok... siendo así, usa este código:

Sub SolverRango()
    Dim i&, uf&
    Application.ScreenUpdating = False
    uf = Range("AG" & Rows.Count).End(xlUp).Row
    For i = 4 To uf
        If Range("AG" & i) <> -1 And Range("AH" & i) <> -1 Then
            Range("AG" & i).Resize(, 2) = Array(1, 70)
            SolverReset
            SolverAdd "$AH$" & i, 1, "100"
            SolverAdd "$AH$" & i, 3, "$AB$" & i
            SolverOk "$AQ$" & i, 3, 0, "$AG$" & i & ":$AH$" & i, 1, "GRG Nonlinear"
            SolverSolve True
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

¡Bendiciones!

Share this post


Link to post
Share on other sites

 estimado @johnmpl la hiciste nuevamente!!!! eres un genio!!!!!! muchas gracias, funcionó a la perfección, lo probé en el archivo original de más de 2.000 registros, se demora cerca de 30 minutos, pero funciona!!!, estoy muy agradecido por tu apoyo siempre... muchas bendiciones!! y muchas gracias de nuevo!! 

Pd. cómo doy por resuelta mi consulta??

Share this post


Link to post
Share on other sites
Hace 2 horas, soda1206 dijo:

estimado @johnmpl la hiciste nuevamente!!!! eres un genio!!!!!! muchas gracias, funcionó a la perfección

Muchas gracias por tus cumplidos... aún sigo siendo un aprendiz entusiasta de Excel.

Hace 2 horas, soda1206 dijo:

funcionó a la perfección, lo probé en el archivo original de más de 2.000 registros, se demora cerca de 30 minutos, pero funciona!!!

Quizá se pueda bajar el tiempo de ejecución con estas otras líneas añadidas.  Agregué a la macro un contador de tiempo.  ¡Me cuentas cómo te va!

Sub SolverRango()
    Dim i&, uf&, t#
    t = Timer
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    uf = Range("AG" & Rows.Count).End(xlUp).Row
    For i = 4 To uf
        If Range("AG" & i) <> -1 And Range("AH" & i) <> -1 Then
            Range("AG" & i).Resize(, 2) = Array(1, 70)
            SolverReset
            SolverAdd "$AH$" & i, 1, "100"
            SolverAdd "$AH$" & i, 3, "$AB$" & i
            SolverOk "$AQ$" & i, 3, 0, "$AG$" & i & ":$AH$" & i, 1, "GRG Nonlinear"
            SolverSolve True
        End If
    Next i
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Proceso terminado en: " & Format(Timer - t, "0.000 seg")
End Sub

¡Bendiciones!

Hace 2 horas, soda1206 dijo:

Pd. cómo doy por resuelta mi consulta??

Das por resuelta tu consulta cuando dices algo como TEMA SOLUCIONADO.  Uno de los moderadores, al verlo, puede cerrar tu tema (incluyéndome, pues soy uno de los moderadores del foro).  ¡Bendiciones!

Share this post


Link to post
Share on other sites

Estimado @johnmpl probé tu último código (en el mismo archivo original con más de 2.000 registros) que pudiera optimizar el tiempo de ejecución y te comento que se demora mucho más, a la hora con 10 minutos tuve que cancelar el proceso ya que necesitaba realizar otras labores en excel, pero me quedo con el código anterior que respondió más menos entre 30 a 40 minutos, es entendible la demora...son más de 2000 registros y el proceso tedioso del mismo cálculo que realiza la macro. Quedé feliz con tu solución y aprovecho de felicitarte y agradecerte nuevamente por tu apoyo, hasta la próxima consulta :). TEMA SOLUCIONADO.

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png