Question

我正在为Excel编写一个宏，它正在搜索两个独特的标准，并对包含适当字段中的条件的所有数据进行计数和求和。我已经能够使用AutoFilters执行此操作，但我的代码运行速度非常慢。它需要搅拌近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

加快过滤宏

2 个答案: