Question

工作簿的结构如下。

针对长记录列表（100,000）运行高级过滤器，以便根据从列表中的1条记录派生的条件开始返回记录。
使用小计对高级过滤器进行编号，以便将每条记录的详细信息提取到另一个标签上以进行进一步计算（对差异进行调整）。
“已调整”的数字会返回高级过滤器标签，并从低到高排序。
非过滤器选项卡上的各种数字将被写入文件。
整个过程可能会重复1,000次

问题：

有什么想法可以提高流程的执行速度？我知道瓶颈是在循环中进行了如此多的重新计算并不断重新运行过滤器。
使用我没想过的不同方法的任何想法都能以更高效或简化的方式完成同样的事情？

不幸的是，由于尺寸的原因，我无法发布WB或样本。

    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 = 
    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
    Next
    Application.ScreenUpdating = True
End Sub

Answer 1

我实际上会在这上面使用PowerQuery。它可能更快，特别是如果你想要计算新细胞并将它们放入表中。 PowerQuery是免费的，并且从Excel 2010开始（2016年被称为“Get＆amp; Transform”）的任何东西都很好。计算以DAX / DML编写。非常强大，可能比VBA解决方案更快/更直观。

高级过滤器的替代方案与大数据集上的小计和索引/匹配相结合

1 个答案: