Excel VBA：从求解器迭代中复制单元格并使用 VBA 将结果粘贴到表中

Question

我的 VBA 编码经验非常有限，对于任何幼稚的问题，请提前致歉。我附上了我的 Excel 表格，这样你就可以看到我指的是什么。

对于一个班级项目，我得到了一系列 15 个项目。这些项目有一系列的利润和收入输入，但所有这些都保持不变，除了一个列。我应该使用求解器找到这些项目中最有价值的组合，同时最大限度地降低成本。我明白该怎么做。但我应该使用 VBA 编码通过表格运行一个替代值列表，并为每个值解决最佳项目组。 O5中的生命值和O6中的伤害值是变化的。对于每次求解器迭代，我需要一次用这些值替换列表中的值（单元格 N11 到 O26）。此外，对于我浏览列表时的每个结果，我需要制作另一个表格来记录所选项目。所以对于我给出的图片，我需要记录 F1、G、H 和 J1。

我的问题是：如何使用 VBA 循环求解器通过变量表并将每次求解器迭代的结果记录在新表中？我在想我会使用 VBA 根据“选择”列中的二进制求解器结果，使用已批准的项目复制单元格的内容，但我不知道该怎么做。

任何帮助将不胜感激，谢谢！

Excel Table1:https://i.stack.imgur.com/8CCmX.png

Answer 1

我自己解决了。我不知道这是否会帮助任何人，但这是我的代码。

Sub Sheet1()

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .DisplayStatusBar = False
End With


Dim i As Integer
Dim j As Integer
Dim k As Integer


For i = 12 To 26
'Enters Life Value for iteration
Range("O5").Value = Range("N" & i).Value

'Enters Injury Value for iteration
Range("O6").Value = Range("O" & i).Value

    'Solve Scenario with given Life and Injury Values
    SolverSolve UserFinish:=True

        'Sets up a table which collects all the chosen projects into one column
        'so they can be selected and put into a single cell as the result for the loop iteration
        For k = 5 To 21
            binary = Range("L" & k).Value

            'Enters Project Name if solver choses it
            If binary = 1 Then Range("T" & k) = Range("B" & k).Value
            'Returns cell to blank if project is not chosen
            If binary = 0 Then Range("T" & k) = Range("A" & k).Value

            Next

        'Copy the projects selected into a table of results
          Range("R25").Value = "=CONCAT(T5:T21)"
          Range("R25").Copy
          Range("W" & i).PasteSpecial xlPasteValues

        'Copy the Cost of each project selection iteration into table
          Range("P9").Copy
          Range("X" & i).PasteSpecial xlPasteValues

          'Copy the number of projects selected for each scenario
          Range("Y" & i).Value = Range("N9")


'Returns the choice column to all zeros in preparation for new loop
Range("L5:L21").Value = 0

Next

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayStatusBar = True
End With
End Sub