加速过滤宏

Question

我正在为Excel编写一个宏，该宏正在搜索两个唯一的标准，并计数和总结所有包含正确字段中标准的数据。我已经可以使用自动滤波器来执行此操作，但是我的代码运行速度非常慢。它需要搅拌近25,000行，并且在5分钟内完成了大约180行，这并不理想。我想知道是否有更好，更有效的方法来做到这一点。

我的代码是：

For i = 2 To lr2
    sh1.Range("A1").AutoFilter Field:=3, Criteria1:=sh2.Cells(i, 1)
    sh1.Range("A1").AutoFilter Field:=5, Criteria1:=sh2.Cells(i, 2)
    count = sh1.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.count
    sh2.Cells(i, 3).Value = (count - 1)
    Set rng = sh1.Range("G2:G" & lr1)
    sum = sh1.Application.WorksheetFunction.sum(rng.SpecialCells(xlCellTypeVisible))
    sh2.Cells(i, 4).Value = sum
Next i

SH1和SH2是工作表1和2，而LR2是SH2中参考电子表格中的最后一行的数量。

Answer 1

最好完全摆脱循环：

With sh2
    With .Range("D2:D" & lr2)
        .FormulaR1C1 = "=SUMIFS('" & sh1.Name & "'!C7:C7,'" & sh1.Name & "'!C3:C3,RC1,'" & sh1.Name & "'!C5:C5,RC2)"
        .Value = .Value
    End With
    With .Range("C2:C" & lr2)
        .FormulaR1C1 = "=COUNTIFS('" & sh1.Name & "'!C3:C3,RC1,'" & sh1.Name & "'!C5:C5,RC2)"
        .Value = .Value
    End With
End With

Answer 2

如果您正在做任何读取和/或在非常大的单元格中写入和/或写入的，我建议将范围转换为阵列并迭代该范围（然后将阵列写回数组如有必要，到达范围）。尝试看起来像这样的代码：

Dim ReadArray() as Variant
ReadArray = MyRange
Dim Count as Long
Dim Criteria1 as String, Criteria2 as String
Criteria1 = "Alpha"
Criteria2 = "Bravo"
Dim Row as long, Col as long
For Row = 1 to Ubound(ReadArray, 1)
    for Col = 1 to Ubound(ReadArray, 2)
        if ReadArray(Row, Col) = Criteria1 or ReadArray(Row, Col) = Criteria2 then
            Count = Count + 1
        End If
    next Col
Next Row