Visual Basic para Aplicaciones - ¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Life is soft - evento anual de software empresarial

Pos: 71

Val: 11

¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Publicado por Jesús (5 intervenciones) el 24/10/2018 06:08:43

Hola, antes que nada gracias por su tiempo. Ojala que me puedan ayudar. Soy nuevo en VBA y requiero hacer lo siguiente. Ya realicé un macro (que adjunto) que hace exactamente lo que quiero pero solo para la primer corrida. Lo que hace basicamente es que copia las celdas (A5:C5) de la hoja VLE CO2 y pega los valores en las celdas (A13:C13) de la hoja CEOS_estudiante, despues ejecuta un par de macros (la hoja CEOS no la hice yo pero funcionan correctamente sus datos) y ejecuto el SOLVER. Despues el resultado que esta en la celda B6 lo pega en la celda G5 de la hoja de VLE CO2 y se termina el primer ciclo. Lo que requiero es que ahora tome las celdas (A6:C6) haga todo el chanchullo y pegue el dato de la celda B6 en la celda G6 de la hoja original y asi sucesivamente (aclaro que las celdas de la hoja CEOS nunca se van a mover). Ya intenté realizar un ciclo for y nada :/. Anexo una imagen esperando que se entienda mejor.

Sub Macro12()

' Macro12 Macro

    Windows("VLE_CO2.xlsx").Activate

    Range("A5:C5").Copy

    Windows("CEoS_Estudiante_J.xlsm").Activate

    Range("A13:C13").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.Run "CEoS_Estudiante_J.xlsm!Macro3"

    Application.Run "CEoS_Estudiante_J.xlsm!Macro1"

    Application.DisplayAlerts = False

    SolverOk SetCell:="$F$7", MaxMinVal:=3, ValueOf:=0, ByChange:="$F$6:$H$6", _

        Engine:=1, EngineDesc:="GRG Nonlinear"

    SolverOk SetCell:="$F$7", MaxMinVal:=3, ValueOf:=0, ByChange:="$F$6:$H$6", _

        Engine:=1, EngineDesc:="GRG Nonlinear"

    SolverSolve True

    Application.DisplayAlerts = True

    Range("B6").Copy

    Windows("VLE_CO2.xlsx").Activate

    Range("G5").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

End Sub

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 1

Val: 1.134

¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Publicado por Antoni Masana (498 intervenciones) el 26/10/2018 07:58:10

Parece muy complejo lo que he cambiado pero hay pocos cambios, te resalto lo que he cambiado el resto son comentarios:

Sub Macro12()

    Dim Fila as Long

    Fila=5

    ' ---&--- Se ejecuta mientras hay datos en la columna A

    While Range("A" & Fila) <> ""

        ' ---&--- Copia la Fila de datos

        Windows("VLE_CO2.xlsx").Activate

        Range("A" & Fila & ":C" & Fila).Copy

        ' ---&--- Pega los datos en el Destino

        Windows("CEoS_Estudiante_J.xlsm").Activate

        Range("A13:C13").PasteSpecial Paste:=xlPasteValues, _

                                      Operation:=xlNone, _

                                      SkipBlanks :=False, _

                                      Transpose:=False

        ' ---&--- Ejecuta DOS Macros

        Application.Run "CEoS_Estudiante_J.xlsm!Macro3"

        Application.Run "CEoS_Estudiante_J.xlsm!Macro1"

        Application.DisplayAlerts = False

        ' ---&--- Ejecuta el Solver

        SolverOk SetCell:="$F$7", MaxMinVal:=3, _

                                  ValueOf:=0, _

                                  ByChange:="$F$6:$H$6", _

                                  Engine:=1, _

                                  EngineDesc:="GRG Nonlinear"

        SolverOk SetCell:="$F$7", MaxMinVal:=3, _

                                  ValueOf:=0, _

                                  ByChange:="$F$6:$H$6", _

                                  Engine:=1, _

                                  EngineDesc:="GRG Nonlinear"

        SolverSolve True

        Application.DisplayAlerts = True

        ' ---&--- Copia el resultado

        Range("B6").Copy

        ' ---&--- Pega el resultado

        Windows("VLE_CO2.xlsx").Activate

        Range("G" & Fila).Select

        Selection.PasteSpecial Paste:=xlPasteValues, _

                               Operation:=xlNone, _

                               SkipBlanks :=False, _

                               Transpose:=False

        ' ---&--- Salta a la línea siguiente

        Fila = Fila +1

    Wend

End Sub

Esta sin probar.

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 71

Val: 11

¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Publicado por Jesús (5 intervenciones) el 26/10/2018 08:07:20

Muchas gracias por su respuesta, de hecho hoy lo logré resolver de una forma, pero la de usted me parece mucho más completa, ya que yo lo solucioné con un formato i=1 to N, y tengo que ver cuántos datos tiene mi rango e ir cambiando el código. Ahora una pregunta, ¿Sabe usted como puedo hacer que si el solver no converge y me arroja un resultado del tipo: "error, no se encontró una solución global" (o algo así dice) , escriba en la celda objetivo Range("G" & Fila).Select algo como "error"? Usaría un if pero no sé cómo el código pueda identificar el resultado que si solver si llegó a una solución.

Valora esta respuesta

Comentar

Pos: 1

Val: 1.134

¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Publicado por Antoni Masana (498 intervenciones) el 26/10/2018 12:33:08

He vist un ejemplo de como funciona el SOLVER y cuando no tiene solución da un mensaje, no conocía el SOLVER.

Una idea que se me ha ocurrido es poner un texto en la celda del resultado y si cuando finalice el SOLVER sigue estando el texto es que no lo ha podido solventar.

La macro queda asi:

Sub Macro12()

    Dim Fila as Long

    Fila=5

    ' ---&--- Se ejecuta mientras hay datos en la columna A

    While Range("A" & Fila) <> ""

        ' ---&--- Copia la Fila de datos

        Windows("VLE_CO2.xlsx").Activate

        Range("A" & Fila & ":C" & Fila).Copy

        ' ---&--- Pega los datos en el Destino

        Windows("CEoS_Estudiante_J.xlsm").Activate

        Range("A13:C13").PasteSpecial Paste:=xlPasteValues, _

                                      Operation:=xlNone, _

                                      SkipBlanks :=False, _

                                      Transpose:=False

        Range("B6") = "Error"

        ' ---&--- Ejecuta DOS Macros

        Application.Run "CEoS_Estudiante_J.xlsm!Macro3"

        Application.Run "CEoS_Estudiante_J.xlsm!Macro1"

        Application.DisplayAlerts = False

        ' ---&--- Ejecuta el Solver

        SolverOk SetCell:="$F$7", MaxMinVal:=3, _

                                  ValueOf:=0, _

                                  ByChange:="$F$6:$H$6", _

                                  Engine:=1, _

                                  EngineDesc:="GRG Nonlinear"

        SolverOk SetCell:="$F$7", MaxMinVal:=3, _

                                  ValueOf:=0, _

                                  ByChange:="$F$6:$H$6", _

                                  Engine:=1, _

                                  EngineDesc:="GRG Nonlinear"

        SolverSolve True

        Application.DisplayAlerts = True

        ' ---&--- Verifica si SOLVER pudo calcular

        If Range("B6") = "Error" Then

            Windows("VLE_CO2.xlsx").Activate

            Range("G" & Fila) = "Error"

        Else

            ' ---&--- Copia el resultado

            Range("B6").Copy

            ' ---&--- Pega el resultado

            Windows("VLE_CO2.xlsx").Activate

            Range("G" & Fila).Select

            Selection.PasteSpecial Paste:=xlPasteValues, _

                                   Operation:=xlNone, _

                                   SkipBlanks :=False, _

                                   Transpose:=False

        End If

        ' ---&--- Salta a la línea siguiente

        Fila = Fila +1

    Wend

End Sub

He añadido las líneas 21, 48,49, 50, 51 y 64.

Podría eliminarse el IF y dejar solo la línea 21, porque copia el texto de error y se queda igual a menos que quieras hacer otra cosa.

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 71

Val: 11

¿Como puedo ejecutar un macro para el siguiente conjunto de celdas?

Publicado por Jesús (5 intervenciones) el 26/10/2018 17:28:28

Muchas gracias de nuevo por su respuesta, lamentablemente esta vez no solucionó mi problema, ya que al no converger solver arroja una ventana de error, no un valor como tal, intentaré abrir un nuevo hilo esperando que alguien me pueda ayudar. Un saludo.

Valora esta respuesta

Comentar

Selección de celdas que cumplan una condición

recepcion de datos