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

将VBA解算器与嵌套循环结合使用,vba,excel,Vba,Excel,我有一个大的数据集和一些当前的VBA代码来进行一些计算。我拥有的代码具有以下功能: 它包括两个嵌套循环,并将Excel中某些方程式的结果复制粘贴到一个大型汇总表中 然后,代码对数据进行排序,并应用一些具有多种标准的高级过滤器,以获得解决方案 我想知道是否有可能使用VBA解算器代码通过改变高级过滤条件和当前循环来最大化我的解决方案?我必须在这一点上手动迭代,但希望能够包括解算器,以消除手动迭代,并确定最佳过滤标准,以最大限度地提高解决方案 我意识到,如果我在Excel中有一个简单的等式,比如mx+

我有一个大的数据集和一些当前的VBA代码来进行一些计算。我拥有的代码具有以下功能:

  • 它包括两个嵌套循环,并将Excel中某些方程式的结果复制粘贴到一个大型汇总表中
  • 然后,代码对数据进行排序,并应用一些具有多种标准的高级过滤器,以获得解决方案 我想知道是否有可能使用VBA解算器代码通过改变高级过滤条件和当前循环来最大化我的解决方案?我必须在这一点上手动迭代,但希望能够包括解算器,以消除手动迭代,并确定最佳过滤标准,以最大限度地提高解决方案

    我意识到,如果我在Excel中有一个简单的等式,比如
    mx+b=c
    ,我想通过改变
    m
    b
    来最大化
    c
    的值,那么解算器的基本功能就非常有效。但我不确定是否可以,或者如何在当前循环中应用解算器我的主要问题是,是否有人认为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
    

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

    您是否尝试过打开“录制宏”以执行您想对解算器执行的操作,然后查看代码?我从来没有这样做过,但是如果录制宏,我会从那里开始录制。谢谢您的回复。约翰,我要在亚马逊上看看那本书。解决方案单元确实取决于标准范围,但它不是通过excel方程式和公式直接链接的。它仅基于应用于结果表的条件/过滤器进行链接,然后提供各种解决方案。也就是说,你认为我有机会让一些解算器代码发挥作用吗?如果你需要选择一些但不是所有的潜在投资(或者你正在尝试做的任何事情),你可以使用一列0-1变量和函数,比如SUMPRODUCT。您通常可以使用二进制决策变量模拟过滤器的功能,如果您想使用内置解算器,可能需要这种移动。