Solver

jabrajam · el 14 de febrero

Buenos dias,

No soy capaz que funcione la macro, os explicco:

Mi objetvo es:

Macro 1: Conseguir que inserte una fila nueva cada cambio de celda de la columna a sea diferente. Despues de muchos dias y copiando ejemplos de la web conseguido

Macro 2: Paso 1: que realice sumatorio de la columna J hasta espacio blanco y mantenga formula en la celda,( le llamare en este post obj1 y al range para su obtencion Range1). Despues de muchos dias y copiando ejemplos de la web conseguido

Paso 2:que realice sumaproducto de la columna J * la columna K hasta espacio blanco y mantenga formula en la celda y lo divida por el obj1, consiguiendo el precio neto,( le llamare en este post obj2 y al range para su obtencion Range2)Ej =sumaproducto((J2:J10),(K2:10)/J11). Despues de muchos dias y copiando ejemplos de la web he conseguido hacer la mitad, me sale bien sumaproducto pero cuando divido no me funciona

Paso 3:Hacer un solver con las siguientes restrinciones: para cada linea que hemos insertado hacer un solver

             SolverOk SetCell:=Range(obj2).Address, MaxMinVal:=3, ValueOf:=Range(valor obj2).Value, ByChange:=Range(los range de la obtencion de obj1 y obj2)
            SolverAdd CellRef:=Range(Range1), Relation:=3, FormulaText:=Range( Range1- 2 columna)
            SolverAdd CellRef:=Range(Range2), Relation:=3, FormulaText:=Range( Range2- 2 columna)
            SolverAdd CellRef:=Range(obj1), Relation:=2, FormulaText:=Range(valor obj1)

SolverSolve

paso3 Despues de muchos dias y copiando ejemplos de la web he tirado la toalla y recurro al templo de sabiduria que sois vosotros

Gracis por antiipado y espero haberme explicado bien

prueba.xlsm

jabrajam · el 17 de febrero

Solucionado.

Despues de muchas horas y ejemplos de web

Sub InsertTotals()
'Updateby Extendoffice
    Dim xRg, i As Range
    Dim j, StartRow, StartCol As Integer
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.AddressLocal
    Set xRg = Application.InputBox("please select the cells:", "Kutools for Excel", xTxt, , , , , ?
    If xRg Is Nothing Then Exit Sub
    StartRow = xRg.Row
    StartCol = xRg.Column
    'For i = StartCol To xRg.Columns.Count + StartCol - 1
        For j = xRg.Row To xRg.Rows.Count + StartRow - 1
            If Cells(j, 10) = "" Then
                Cells(j, 10).Formula = "=SUM(" & Cells(StartRow, 10).Address & ":" & Cells(j - 1, 10).Address & ")"
               Range(i) = Range("J" & j).Address
                Cells(j, 11).Formula = "=SUMPRODUCT((" & Cells(StartRow, 10).Address & ":" & Cells(j - 1, 10).Address & "),(" & Cells(StartRow, 11).Address & ":" & Cells(j - 1, 11).Address & ")/" & Cells(j, 10).Address & ")"
                Cells(j, 12).Formula = Range("K" & j).Address / Range("J" & j).Address
            SolverOk SetCell:=Range("J" & j).Address, MaxMinVal:=3, ValueOf:=Range("J" & j).Value, ByChange:=Range(Cells(StartRow, 11).Address, Cells(j - 1, 11).Address)
            SolverAdd CellRef:=Range(Cells(StartRow, 11).Address, Cells(j - 1, 11).Address), Relation:=3, FormulaText:=Range(Cells(StartRow, 9).Address, Cells(j - 1, 9).Address)
            SolverAdd CellRef:=Range(Cells(StartRow, 10).Address, Cells(j - 1, 10).Address), Relation:=3, FormulaText:=Range(Cells(StartRow, 8).Address, Cells(j - 1, 8).Address)
            SolverAdd CellRef:=Range("I" & j).Address, Relation:=2, FormulaText:=Range("I" & j).Value

SolverSolve

                StartRow = j + 1
            End If
        Next
        StartRow = xRg.Row
    'NEXT
End Sub

Ahora para rizar el rizo quiero cambiar el Engine asi:

SolverReset
            SolverOk SetCell:=Range("K" & j).Address, MaxMinVal:=3, ValueOf:=Range("K" & j).Value, ByChange:=Range("J" & StartRow, "K" & (j - 1)).Address
            SolverAdd CellRef:=Range("K" & StartRow, "K" & (j - 1)).Address, Relation:=3, FormulaText:=Range("I" & StartRow, "I" & (j - 1)).Address, Engine:=2, EngineDesc:="Simplex LP"
            SolverAdd CellRef:=Range("J" & StartRow, "J" & (j - 1)).Address, Relation:=3, FormulaText:=Range("H" & StartRow, "H" & (j - 1)).Address, Engine:=2, EngineDesc:="Simplex LP"
            SolverAdd CellRef:=Range("I" & j).Address, Relation:=2, FormulaText:=Range("I" & j).Value, Engine:=2, EngineDesc:="Simplex LP"

            SolverSolve UserFinish:=True
            SolverFinish KeepFinal:=1

y me da error de compilacion. no se encontro el argumento con nombre (Engine)

Alguien me puede ayudar, gracias

pegones1 · el 19 de febrero

Hola Jabrajam, creo que te falta una referencia a Solver, como explica el enlace:

En el editor de Visual Basic, con un módulo activo, haga clic en referencias en el menú herramientas y, a continuación, seleccione Solver en referencias disponibles. Si Solver no aparece en ** Referencias disponibles**, haga clic en Examinar y, a continuación, abra Solver.xlam en la subcarpeta \Archivos de programa\Microsoft Office\Office14\Library\SOLVER.