时间戳

首页 > 解决方案 > 加速 SUMIF 的提示

excel - 加速 SUMIF 的提示

问题描述

我有一个计算以下内容的 Excel 宏


Range("P2").Formula = "=SUMIF($B$2:B2,B2,$O$2:O2)*O2"
Range("P2").AutoFill Destination:=Range("P2:P" & LastRowData)
Range("P2:P" & LastRowData).Calculate

    In Column B is a list of names (with multiple rows with the same name)
    In Column O is a number (either 0 or 1)

本质上，我试图增加一列（从 1 开始）来计算他们的下一个可用约会（如果我什至应该在计算中考虑该行，那么列 O 是）。

我每天运行这个，上述步骤很容易运行超过 15 分钟，因为我的文件非常大（就行而言，在 100,000 到 200,000 行之间）

有什么办法可以加快这个速度吗？我充其量是 Excel 宏的中级。

标签： excelvbaperformanceoptimization

解决方案

这让我想起了我必须处理的类似 SUMIFS() 问题。以下代码不使用数组（这可能会更快），但我在 200K 行数据上对其进行了测试，它在 6 到 8 秒之间完成。

它假定 Q & R 列可用作“帮助”列，并且所有操作都发生在文件的第 1 页上。我提供了“正常” SUMIF() 计算，以及根据您的明显计算乘以列 O 的选项。注释掉不使用的。让我知道事情的后续。

Option Explicit
Sub QuickerSumif()
Dim LastRow As Long, a As Double
a = Timer

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual

'Get the last row based on the names column (B)
LastRow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row

'Store the original order
With Sheet1.Range("R2:R" & LastRow)
    .Formula = "=Row()"
    .Value = .Value
End With

'Sort the data by names (column B)
Sheet1.Columns("A:R").Sort Key1:=Sheet1.Range("B2"), _
order1:=xlAscending, Header:=xlYes

'Sum the 1/0 values for each name with a simple IF() formula
With Sheet1.Range("P2:P" & LastRow)
    .FormulaR1C1 = "=IF(RC2=R[-1]C2,RC15+R[-1]C16,RC15)"        '<~~ 'normal' SUMIF()
    '.FormulaR1C1 = "=IF(RC2=R[-1]C2,RC15+R[-1]C16,RC15)*RC15"   '<~~ your formula
    .Value = .Value
End With

'Sort again by names and 'accumulated' sum
Sheet1.Columns("A:R").Sort Key1:=Sheet1.Range("B2"), order1:=xlDescending, _
Key2:=Sheet1.Range("P2"), order2:=xlDescending, Header:=xlYes

'Get the max accumulated sum for each name with a simple IF() formula
With Sheet1.Range("Q2:Q" & LastRow)
    .FormulaR1C1 = "=IF(RC2=R[-1]C2,R[-1]C17,RC16)"
        .Value = .Value
End With

'Replace column P data with the SUMIF equivalent
Sheet1.Range("P2:P" & LastRow).Value = Sheet1.Range("Q2:Q" & LastRow).Value

'Restore the original order
Sheet1.Columns("A:R").Sort Key1:=Sheet1.Range("R2"), order1:=xlAscending, Header:=xlYes

'Delete the 2 x helper columns
Sheet1.Range("Q:R").EntireColumn.Delete

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic

Msgbox Timer – a
End Sub

推荐阅读