循环与解算器VBA [英] Loop With Solver VBA

问题描述

我有以下的代码，运行一个单一的优化通过求解器，我想在一个循环中运行。单次运行代码是：

  Sub Macro4 
 SolverReset 
 SolverOk SetCell：=$ D $ 36 ，MaxMinVal：= 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverAdd CellRef：=$ S $ 7，关系：= 2，FormulaText：=1 
 SolverAdd CellRef：=$ D $ 7：$ R $ 7，关系：= 1，FormulaText：=$ D $ 6：$ R $ 6
 SolverAdd CellRef：=$ D $ 7：$ R $ 7，关系：= 3，FormulaText：=$ D $ 5：$ R $ 5
 SolverAdd CellRef：=$ D $ 37，关系：= 2，FormulaText：=$ D $ 41
 SolverOk SetCell：=$ D $ 36，MaxMinVal = = 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverSolve UserFinish：= True 
 SolverFinish KeepFinal ：= 1 
 
 
范围（D37）。选择
 Selection.Copy 
范围（E41）。选择
 ActiveSheet.Paste 
范围（D36）。选择
 
 Application.CutCopyMode = False 
 Selection.Copy 
范围（F41）。选择
 ActiveSheet.Paste 
范围（D36）。选择
 
 
范围（D7：R7）。选择
 Application.CutCopyMode = False 
 
 
 Selection.Copy 
范围（I41）。选择
 ActiveSheet.Paste 
 End Sub 
  

求解器优化为$ D $ 41（包括其他约束）中的值，然后通过复制几个单独的单元格和数组来粘贴解决方案，然后将它们与原始目标单元格（即进入第41行）这个效果很好。然而，我试图让它运行一列目标单元格，通过使用循环（或更好的替代方法）依次将它与列之间的解决方案粘贴在一起，通过使其针对列中的每个单元格进行优化，因为它与单次运行代码例如，我正在尝试将其与以下代码合并

  Sub Complete（）
'
' 
'
 Dim Count As Double 
 Dim Count2 As Integer 
 Dim increment As Double 
 increment = Range（C43）。value 
 strt = Range （C41）值
 fnsh =范围（C42）值
 
对于Count = strt To fnsh步增量
 Count2 =计数/递增
 Range（D41）。Offset（Count2，0）= Count 
 Next Count 
 End Sub 
  

生成目标值列（从strt到fnsh使用增量），Solver要取而代之的是（我想!!!）说 FormulaText：= $ D $ 41\" 。然而，我遇到各种错误和投诉（Object'_Global'failed的方法'Range'，其中突出显示Range（E41 + Count）行。选择。我的完整代码是：

 `Sub Macro5（）
 Dim Count As Double 
 Dim Count2 As Integer 
 Dim increment As Double 
 increment =值（C43）值
 strt = Range（C41）值
 fnsh =范围（C42）值
 
对于Count = strt To fnsh增量
 Count2 =计数/递增
范围（D41）。偏移量（Count2，0）=计数
 
 SolverReset 
 SolverOk SetCell：=$ D $ 36，MaxMinVal：= 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverAdd CellRef：=$ S $ 7，Relation：= 2，FormulaText： 1
 SolverAdd CellRef：=$ D $ 7：$ R $ 7，关系：= 1，FormulaText：=$ D $ 6：$ R $ 6
 SolverAdd CellRef：=$ D $ 7 ：$ R $ 7，关系：= 3，FormulaText：=$ D $ 5：$ R $ 5
 SolverAdd CellRef：=$ D $ 37，关系：= 2，FormulaText：=$ D $ 41： $ D $ 41 + Count
 SolverOk SetCell：=$ D $ 36 ，MaxMinVal = = 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverSolve UserFinish：= True 
 SolverFinish KeepFinal：= 1 
 
 
范围（D37）。选择
 Selection.Copy 
范围（E41 + Count）。选择
 ActiveSheet.Paste 
范围（D36 ）。选择
 Application.CutCopyMode = False 
 Selection.Copy 
范围（F41 + Count）。选择
 ActiveSheet.Paste 
 
范围（D7：R7）。选择
 Application.CutCopyMode = False 
 Selection.Copy 
范围（I41 + Count）。选择
 ActiveSheet.Paste 
 
下一个计数
结束子`
  

我只需要它来更新哪个单元格它正在优化（并将其放在求解器的约束中），然后更新要复制的单元格以及在哪里粘贴它们。任何帮助将不胜感激。

解决方案

 范围（E41 +计数）。选择
  

这是不正确的语法。以下是首选：

  Range（E41）。Offset（Count，0）.Select 
  

或者您可以使用

  Range（E& 41 + Count）。选择
  

一般来说，避免使用Range在它前面的工作表名称。另外，只有选择你需要的时候，几乎从来没有。以下是一个不使用任何Select方法的示例。

  Sub Complete（）
 
 Dim lStrt As Long，lFnsh As Long 
 Dim lCount As Long，lCount2 As Long 
 Dim lIncrement As Long 
 
 For lCount = lStrt To lFnsh Step lIncrement 
 lCount2 = lCount / lIncrement 
 
 Sheet1.Range（D41）。Offset（lCount2，0）.Value = lCount 
 
 SolverReset 
 SolverOk SetCell：=$ D $ 36 ，MaxMinVal：= 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverAdd CellRef：=$ S $ 7，关系：= 2，FormulaText：=1 
 SolverAdd CellRef：=$ D $ 7：$ R $ 7，关系：= 1，FormulaText：=$ D $ 6：$ R $ 6
 SolverAdd CellRef：=$ D $ 7：$ R $ 7，关系：= 3，FormulaText：=$ D $ 5：$ R $ 5
 SolverAdd CellRef：=$ D $ 37，关系：= 2，FormulaText：= Sheet1.Range（D41） .Offset（lCount2，0）.Address 
 SolverOk SetCell：=$ D $ 36，MaxMinVal = = 2，ValueOf：=0，ByChange：=$ D $ 7：$ R $ 7
 SolverSolve UserFinish：= T rue 
 SolverFinish KeepFinal：= 1 
 
 Sheet1.Range（E41）。Offset（lCount2，0）.Value = Sheet1.Range（D37）。 Sheet1.Range（F41）。偏移量（lCount2,0）.Value = Sheet1.Range（D36）。值
 Sheet1.Range（D7：R7）。Copy Sheet1.Range（I41 ）.Offset（lCount2，0）
 
下一个lCount 
 
 End Sub 
  




Hi I have the following code which runs a single optimisation through solver which I would like to run in a loop. the single run code is:

    Sub Macro4
SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41").Select
    ActiveSheet.Paste
    Range("D36").Select

Application.CutCopyMode = False
Selection.Copy
Range("F41").Select
ActiveSheet.Paste
Range("D36").Select


Range("D7:R7").Select
Application.CutCopyMode = False


   Selection.Copy
    Range("I41").Select
    ActiveSheet.Paste
End Sub

The solver optimises to a value in $D$41 (amongst other constraints)and then pastes the solutions by copying a couple of individual cells and an array and then pasting them alongside the original target cell (i.e. into row 41.) This works well. However I am trying to get it to run for a column of target cells by getting it to optimise to each cell in the column in turn, by using a loop (or better alternative), before pasting the solutions alongside it as it does for the single run code. For example I am trying to merge it with the following code

    Sub Complete()
'
'
'
Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

    For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count
    Next Count
End Sub

which generates the column of target values (from strt to fnsh using increment) for Solver to take and use instead of (I think!!!) the part that says FormulaText:="$D$41". However I run into various errors and complaints (method 'Range' of Object'_Global'failed- which highlights the line "Range(E41+Count").Select. The complete code I have is:

`Sub Macro5()
   Dim Count As Double
Dim Count2 As Integer
Dim increment As Double
increment = Range("C43").Value
strt = Range("C41").Value
fnsh = Range("C42").Value

For Count = strt To fnsh Step increment
        Count2 = Count / increment
        Range("D41").Offset(Count2, 0) = Count

    SolverReset
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
    SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
    SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:="$D$41:$D$41+Count"
    SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
    SolverSolve UserFinish:=True
    SolverFinish KeepFinal:=1


    Range("D37").Select
    Selection.Copy
    Range("E41+Count").Select
    ActiveSheet.Paste
    Range("D36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F41+Count").Select
    ActiveSheet.Paste

    Range("D7:R7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("I41+Count").Select
    ActiveSheet.Paste

Next Count 
End Sub` 

I just need it to update which cell it is optimising to (and putting it in the constraint of solver), then updating which cells to copy and where to paste them. Any help would be greatly appreciated.

解决方案

Range("E41+Count").Select

This is improper syntax. The following is preferred:

Range("E41").Offset(Count,0).Select

or you could use

Range("E" & 41 + Count).Select

In general, avoid using Range without the sheet name in front of it. Also, only Select when you need to, and that's almost never. Here's an example that doesn't use any Select methods.

Sub Complete()

    Dim lStrt As Long, lFnsh As Long
    Dim lCount As Long, lCount2 As Long
    Dim lIncrement As Long

    For lCount = lStrt To lFnsh Step lIncrement
        lCount2 = lCount / lIncrement

        Sheet1.Range("D41").Offset(lCount2, 0).Value = lCount

        SolverReset
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverAdd CellRef:="$S$7", Relation:=2, FormulaText:="1"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=1, FormulaText:="$D$6:$R$6"
        SolverAdd CellRef:="$D$7:$R$7", Relation:=3, FormulaText:="$D$5:$R$5"
        SolverAdd CellRef:="$D$37", Relation:=2, FormulaText:=Sheet1.Range("D41").Offset(lCount2, 0).Address
        SolverOk SetCell:="$D$36", MaxMinVal:=2, ValueOf:="0", ByChange:="$D$7:$R$7"
        SolverSolve UserFinish:=True
        SolverFinish KeepFinal:=1

        Sheet1.Range("E41").Offset(lCount2, 0).Value = Sheet1.Range("D37").Value
        Sheet1.Range("F41").Offset(lCount2, 0).Value = Sheet1.Range("D36").Value
        Sheet1.Range("D7:R7").Copy Sheet1.Range("I41").Offset(lCount2, 0)

    Next lCount

End Sub

这篇关于循环与解算器VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！