Question

问题：代码每条记录执行约30秒。需要优化速度。电子表格围绕10页的100,000条记录构建，使用高级过滤器和查找将一条记录与列表中最多100条其他记录进行比较。计算各种调整，然后将来自计算的值返回到“输出页面”上，持续约60,000条记录。问题是60,000条记录* 30秒= 500小时。感谢。

Sub EquityAutomated()
    Dim i As Long
    Dim StartNo As Long
    Dim EndNo As Long
    StartNo = InputBox("Enter the row on the Hsheet sheet you want the equity analysis to start on")
    EndNo = InputBox("Enter the row on the Hsheet sheet you want the equity analysis to end on")
    Dim wsProtestTest As Worksheet: Set wsProtestTest = Worksheets("ProtestTestData")
    Dim wsES As Worksheet:          Set wsES = Worksheets("EquitySpreadsheet")
    Dim wsEL As Worksheet:          Set wsEL = Worksheets("EquityList")
    Dim wsDa As Worksheet:          Set wsDa = Worksheets("Res")
    Dim subTotalsDa As Range:       Set subTotalsDa = wsDa.Range("A10:A647649")
    Dim fltrRng As Range:           Set fltrRng = wsDa.Range("A9:T647649")
    Dim fltrCritRng As Range:       Set fltrCritRng = wsDa.Range("A1:T2")
    Dim valRngDa As Range:          Set valRngDa = wsDa.Range("T10:T647649")
    Dim fullSrtRng As Range:        Set fullSrtRng = wsDa.Range("A9:S647649")
    Dim sortValRng As Range:        Set sortValRng = wsDa.Range("T9")
    Dim fullSortRngVal As Range:    Set fullSortRngVal = wsDa.Range("A10:T647649")
    Dim equityRankRng As Range:     Set equityRankRng = wsEL.Range("P5")
    Dim equityOutOfRng As Range:    Set equityOutOfRng = wsEL.Range("P4")
    Dim MedianRng As Range:         Set MedianRng = wsEL.Range("O6")
    Dim propValRng As Range:        Set propValRng = wsEL.Range("D5")
    Dim diffRng As Range:           Set diffRng = wsEL.Range("O7")
    Dim MinRng As Range:            Set MinRng = wsEL.Range("O8")
    Dim MaxRng As Range:            Set MaxRng = wsEL.Range("O9")
    Dim avgRng As Range:            Set avgRng = wsEL.Range("O10")
    Dim LogRng As Range:          Set LogRng = wsES.Range("B10")
    Dim Support3kLowerRng As Range:    Set Support3kLowerRng = wsEL.Range("O11")
    Application.ScreenUpdating = False
    For i = StartNo To EndNo
        LogRng = wsProtestTest.Cells(i + 2, 1).Value2
        subTotalsDa.ClearContents
        Application.Calculate
            If Not Application.CalculationState = xlDone Then
                DoEvents
            End If
        Application.Calculation = xlManual
        fltrRng.AdvancedFilter Action:=xlFilterInPlace, _
            CriteriaRange:=fltrCritRng, Unique:=False
        Application.Calculation = xlCalculationAutomatic
        Application.Calculate
        subTotalsDa.SpecialCells(xlCellTypeVisible).FormulaR1C1 = _
            "=Subtotal(3,R10C2:RC[1])"
        valRngDa.SpecialCells(xlCellTypeVisible).Formula = _
            "=INDEX(EquitySpreadsheet!$C$12:$GT$29,16,(MATCH(INDIRECT(ADDRESS(ROW(),1)),EquitySpreadsheet!$C$12:$GS$12)+1))"
        With wsDa.Sort
            .SortFields.Clear
            .SortFields.Add Key:=valRngDa, SortOn:=xlSortOnValues, _
                Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange fullSortRngVal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .Apply
        End With
        With wsProtestTest
            .Cells(i + 2, 29) = equityRankRng: .Cells(i + 2, 30) = equityOutOfRng: .Cells(i + 2, 31) = Support3kLowerRng
            .Cells(i + 2, 32) = MedianRng:     .Cells(i + 2, 33) = propValRng
            .Cells(i + 2, 34) = diffRng:      .Cells(i + 2, 35) = MinRng
            .Cells(i + 2, 36) = MaxRng:       .Cells(i + 2, 37) = avgRng
        End With
    Next
    Application.ScreenUpdating = True
End Sub

编辑：会发生什么： 1.日志用于提取高级过滤器的标准。 2.清除调整值列（小计）以允许在计算之后重新填充 3.使用之前的条件运行高级过滤器 4.运行过滤器后，将返回单元格中的数据拉入工作表（小计用于为每个返回的记录生成索引/匹配1,2,3等的标识）。索引/匹配用于填充各种调整项目，然后使用基本公式确定对主题的适当调整（平方英尺等） 5.在钙片上对各种量求和以返回“指示值”。然后使用您在宏中看到的索引匹配来填充“valRng”。 6.过滤后的数据根据valRng从低到高排序。 7.值将被带到摘要表以进行存档，因为工作簿的其余部分将随每个新记录一起更新。（使用wsProtestTest部分）。

Answer 1

我无法理解您的整体计算过程，但有些事情需要改变：

而是一次处理一个范围内的单元格（例如C6：C11）使用变量数组
在手动计算模式下运行整个循环，并尽可能不经常使用application.Calculate。
- 找到另一种方法来实现您想要的结果，不涉及排序和过滤650000行60000次！
- INDIRECT是一个易变函数，会减慢计算速度：找到一种不涉及INDIRECT的不同计算方式

通过计算每条记录优化执行速度高级过滤器循环

1 个答案: