新手无法循环求解器。模型中的错误

Question

我的问题是：我列出了A2：A61的60所学校。在B栏中，我为A中的每所学校都设置了一组学生。我试图建立一个24级的代码，而不是将同一所学校的学生分开。换句话说，我试图使用Solver将它们组合成24个组。

在C栏中，我有一列为0，在D栏中，我有B列* C列的产品，而在D62中，我有一个D2的总数为D61的单元格。

我的模型是这样的：我使用Solver尝试在更改C列中的0时使D62 = 24，但约束C列的值必须是二进制的。也许有一种更简单的方法可以做到这一点，但这是我到目前为止的代码：

Sub Grouping()

Dim setCellRange As Range, valueofRange As Range, byChangeRange As Range

Set setCellRange = ActiveSheet.Range("D62")
Set valueofRange = ActiveSheet.Range("B63")
Set byChangeRange = ActiveSheet.Range("C2:C61")

Dim i As Long

For i = 1 To 3
Application.Calculation = xlAutomatic
SolverReset
SolverOk SetCell:=setCellRange.Address, MaxMinVal:=3, ValueOf:=valueofRange.Address, ByChange:=byChangeRange.Address, _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverAdd CellRef:=byChangeRange.Address, Relation:=5, FormulaText:="binary"
SolverOk SetCell:=setCellRange.Address, MaxMinVal:=3, ValueOf:=valueofRange.Address, ByChange:=byChangeRange.Address, _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverOk SetCell:=setCellRange.Address, MaxMinVal:=3, ValueOf:=valueofRange.Address, ByChange:=byChangeRange.Address, _
    Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve

Set setCellRange = setCellRange.Cells(1, 4)
Set valueofRange = valueofRange.Cells(1, 1)
Set byChangeRange = byChangeRange.Cells(1, 4)

Cells(1, i * 3 + 2).Value = "# of Students"
Cells(2, i * 3 + 2).Value = "=RC[-3]-RC[-1]"
Cells(2, i * 3 + 2).Select
Selection.AutoFill Destination:=Range(Cells(2, i * 3 + 2), Cells(61, i * 3 + 2))
Range(Cells(2, i * 3 + 2), Cells(61, i * 3 + 2)).Select
Cells(1, i * 3 + 3).Value = "Binary"
Cells(2, i * 3 + 3).Value = "0"
Cells(2, i * 3 + 3).Select
Selection.AutoFill Destination:=Range(Cells(2, i * 3 + 3), Cells(61, i * 3 + 3))
Range(Cells(2, i * 3 + 3), Cells(61, i * 3 + 3)).Select
Cells(1, i * 3 + 4).Value = "Product"
Cells(2, i * 3 + 4).Value = "=RC[-2]*RC[-1]"
Cells(2, i * 3 + 4).Select
Selection.AutoFill Destination:=Range(Cells(2, i * 3 + 4), Cells(61, i * 3 + 4))
Range(Cells(2, i * 3 + 4), Cells(61, i * 3 + 4)).Select
Cells(62, i * 3 + 4).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-60]C:R[-1]C)"

Next i
End Sub

提前致谢。