首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >结合嵌套循环使用VBA求解器

结合嵌套循环使用VBA求解器
EN

Stack Overflow用户
提问于 2015-06-23 23:02:10
回答 1查看 651关注 0票数 0

我有一个大的数据集和一些当前的VBA代码来做一些计算。我所拥有的代码执行以下操作:

  1. 它包括两个嵌套循环和副本,并将Excel中某些方程的结果粘贴到一个大型汇总表中。
  2. 然后,代码对数据进行排序,并应用一些具有许多条件的高级过滤器来达成解决方案。

我想知道是否有可能使用VBA求解程序代码,通过结合当前循环改变高级过滤器标准来最大化我的解决方案?此时,我必须手动迭代它,但希望能够包括求解器,以消除手动迭代,并确定最佳筛选条件以使解决方案最大化。

我意识到,如果在mx + b = c这样的Excel中有一个简单的方程,并且我希望通过改变mb来最大化c的值,那么求解器的基本功能就会很好。但我不确定是否可以,或者如何在我当前的循环中应用我的主要问题是,是否有人认为VBA求解器(或类似的东西)可以用于我的应用程序。

如果需要的话,下面是我的当前代码,请注意,我是在VBA中自学的,所以我的代码可能不是最有效的。

代码语言:javascript
复制
Sub Builder()

Dim LastRow As Long
Dim FirstRow As Long
Dim UsedRng As Range
Dim FirstYr As Integer
Dim LastYr As Integer
Dim Counter1 As Single
Dim DeleteRow As Long

Windows("Model.xlsm").Activate
Sheets("Full List").Select
Set UsedRng = ActiveSheet.UsedRange

LastRow = UsedRng(UsedRng.Cells.Count).Row
Sheets("ModelSummary").Range("F1").Value = LastRow

FirstYr = Sheets("ModelSummary").Range("w5").Value
LastYr = Sheets("ModelSummary").Range("w6").Value

Windows("Portfolio.xlsm").Activate
Sheets("Builder").Select
Range("A7:R23").Select
Selection.ClearContents

Windows("Model.xlsm").Activate
Counter1 = 0

For j = FirstYr To LastYr

    Sheets("Model").Range("o15").Value = j
    Sheets("Full List").Select
    Range(Cells(2, 1), Cells(LastRow + 1, 1)).Select
    Selection.Copy
    Sheets("ModelSummary").Select
    Cells(8, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells(6, 1).Value = j

    Sheets("Model").Select
    Range("H5:H24").Select
    Selection.Copy
    Sheets("ModelSummary").Select
    Cells(7, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    Cells(8, 1).Select

For i = 1 To (LastRow - 1)
    Selection.Copy
    Sheets("Model").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I6:I24").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ModelSummary").Select
    ActiveCell.Offset(0, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    ActiveCell.Offset(1, -1).Select
Next

Range(Cells(7, 1), Cells(LastRow + 6, 20)).Select
ActiveWorkbook.Worksheets("ModelSummary").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ModelSummary").Sort.SortFields.Add Key:=Range( _
    Cells(7, 14), Cells(LastRow + 5, 14)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("ModelSummary").Sort
    .SetRange Range(Cells(7, 1), Cells(LastRow + 6, 20))
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

DeleteRow = Application.Match(Range("o1").Value, Range(Cells(8, 14), Cells(LastRow + 6, 14)), 0) + 7
Range(Cells(DeleteRow, 1), Cells(LastRow + 6, 20)).Clear

Windows("Model.xlsm").Activate
Sheets("ModelSummary").Select
Range(Cells(7, 1), Cells(LastRow + 6, 20)).Select
Range(Cells(7, 1), Cells(LastRow + 6, 20)).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("E2:T3"), Unique:=False
Range("A6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Portfolio.xlsm").Activate
Sheets("Builder").Select
Cells(7, 1 + Counter1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("Model.xlsm").Activate
Range("A6").Select
Selection.ClearContents
Range(Cells(7, 1), Cells(LastRow + 6, 20)).Select
Selection.ClearContents

Counter1 = Counter1 + 1

Next

Windows("Portfolio.xlsm").Activate
Sheets("Builder").Select
Range("S2").Select
Selection.Copy
Sheets("Summary").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End Sub
EN

回答 1

Stack Overflow用户

发布于 2015-06-24 00:06:49

如果您试图最大化的解决方案是一个电子表格单元格,该单元格取决于条件范围的内容,那么当然,您可以使用Solver来尝试为这些范围找到最佳设置。如果依赖不是线性的,那么就不太可能找到全局最优,但是Excel的Solver现在包含了一种可以处理高度非线性函数关系的进化算法。求解器可由VBA控制。除了您可以轻松找到的各种在线教程之外,我还推荐S. Christian Albright ( http://www.amazon.com/VBA-Modelers-Developing-Decision-Microsoft/dp/1285869613/)的“建模者VBA”一书。这是我所知道的为数不多的几本书之一,它深入讨论了如何使用VBA实现求解器的自动化。它甚至有一章介绍了在组合优化中使用VBA (这似乎是您正在做的事情)。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/31014924

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档