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

时间:2015-06-23 23:02:11

标签: excel vba excel-vba

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

  1. 它包括两个嵌套循环,并将Excel中某些方程式的结果复制并粘贴到一个大的汇总表中。
  2. 然后代码对数据进行排序并应用一些高级过滤器,其中包含许多标准以获得解决方案。
  3. 我想知道是否可以通过改变高级过滤条件并结合当前循环来使用VBA求解器代码来最大化我的解决方案?此时我必须手动迭代它,但希望能够包含求解器以消除手动迭代并确定最佳过滤条件以最大化解决方案。

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

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

    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
    

1 个答案:

答案 0 :(得分:0)

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