Visual Basic para Aplicaciones - ¿Como puedo hacer que si solver no encuentra una solución viable me lo señale el codigo ?

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 11
Ha aumentado su posición en 6 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

¿Como puedo hacer que si solver no encuentra una solución viable me lo señale el codigo ?

Publicado por Jesús (5 intervenciones) el 26/10/2018 17:38:11
Hola, antes que nada gracias por su tiempo, tengo un pequeño problema, realicé un pequeño codigo (con la ayuda de un usuario de aquí) que me ayuda a hacer un ciclo en el cual en cada conjunto de celdas se va ejecutando el solver, el problema que tengo es que el codigo no es sensible a si el resultado del solver encontró o no una solucion viable y lo pega de todos modos en la celda de origen, lo que requiero es que si sale el tipico "solver no encontró una solución viable, conservar los resultados" me coloree esa celda o mínimo la deje en blanco y se salte al siguiente ciclo. No se como poner una instruccion que sea sensible al resultado del solver.
Adjunto el codigo.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

¿Como puedo hacer que si solver no encuentra una solución viable me lo señale el codigo ?

Publicado por JuanC (565 intervenciones) el 05/11/2018 14:21:20
deberías evaluar el valor de retorno de SolverSolve
esto puede servirte: https://docs.microsoft.com/en-us/office/vba/excel/concepts/functions/solversolve-function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 11
Ha aumentado su posición en 6 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

¿Como puedo hacer que si solver no encuentra una solución viable me lo señale el codigo ?

Publicado por Jesús (5 intervenciones) el 06/11/2018 18:47:32
Gracias, ya había podido resolver este problema, les dejo aqui la solucion por si a laguien le puede servir.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub PMPa_vs_PMPa()
'
' Macro12 Macro
'
Dim solve As Byte
Dim LibroComponente As String
Dim i
'Application.ScreenUpdating = False
LibroComponente = ActiveWorkbook.Name
For i = 1 To 135
    Application.Calculation = xlCalculationAutomatic
    Windows(LibroComponente).Activate
    Range(Cells(i + 143, 1), Cells(i + 143, 3)).Copy
    Windows("CEoS_Estudiante_J.xlsm").Activate
    Worksheets("VLE").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"
     SolverOk SetCell:="$F$7", MaxMinVal:=3, ValueOf:=0, ByChange:="$F$6:$H$6", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    solve = SolverSolve(UserFinish:=True)
    If solve = 0 Then
    Range("B6").Copy
    Windows(LibroComponente).Activate
    Cells(i + 143, 11).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Else
     Range("B6").Copy
    Windows(LibroComponente).Activate
    Cells(i + 143, 11).Interior.Color = vbRed
    End If
    Next i
    Beep
'Application.ScreenUpdating = True
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar