Question

我正在尝试使用此代码过滤3个不同工作表上的数据，但是当我使用filterBy一键完成所有工作时，expressPrepper子在第二和第三工作表上的运行速度明显降低。

我猜想第二个filter by和第三个Sub filterBy(filterlist As String, col As String, sht As String) Dim myArr As Variant myArr = buildArray(filterlist) clean myArr, col, sht End Sub Function buildArray(filterlist As String) As Variant Dim myTable As ListObject Dim TempArray As Variant Select Case filterlist Case Is = "I" Set myTable = Sheets("Competitive Set").ListObjects("Table1") TempArray = myTable.DataBodyRange.Columns(1) buildArray = Application.Transpose(TempArray) Case Is = "T" Set myTable = Sheets("Competitive Set").ListObjects("Table1") TempArray = myTable.DataBodyRange.Columns(2) buildArray = Application.Transpose(TempArray) Case Is = "IB" Set myTable = Sheets("Competitive Set").ListObjects("Table2") TempArray = myTable.DataBodyRange.Columns(1) buildArray = Application.Transpose(TempArray) Case Is = "TB" Set myTable = Sheets("Competitive Set").ListObjects("Table2") TempArray = myTable.DataBodyRange.Columns(2) buildArray = Application.Transpose(TempArray) Case Is = "AB" Set myTable = Sheets("Competitive Set").ListObjects("Table3") TempArray = myTable.DataBodyRange.Columns(1) buildArray = Application.Transpose(TempArray) End Select End Function Sub clean(arr As Variant, col As String, sht As String) Dim IsInArray As Long Dim product As String Dim lastRow As Long, i As Long Dim progress As Double With Sheets(sht) lastRow = .Cells(Rows.Count, col).End(xlUp).Row For i = lastRow To 2 Step -1 product = .Cells(i, col).Value IsInArray = UBound(filter(arr, product)) If IsInArray < 0 Then .Rows(i).EntireRow.Delete End If progress = ((lastRow - i) / lastRow) * 100 progress = Round(progress, 2) Debug.Print progress Next i End With End Sub Sub expressPrepper() filterBy "AB", "C", "Spend" filterBy "AB", "C", "IMP" filterBy "AB", "C", "GRP" End Sub的运行速度大约是第一个{1/1}的速度。我不知道为什么。

所有三张纸都包含相似的数据，尽管第三张实际上比前两张（每张约16000行）短（〜6500行）。

任何帮助将不胜感激！

registration_ids

Answer 1

如果我正确地理解了您的程序，则无需进行过滤，因此，应用数千个过滤器也不会出现问题。我已经按照我的理解方式重新编写了您的程序，基本上没有这种需要，删除了在指定列中没有重复的行。该代码未经测试。

Sub ExpressFilter()

    Dim Flt() As String, i As Integer
    Dim Sp() As String, j As Integer
    Dim TblName As String
    Dim ClmRng As Range

    Flt = Split("AB,C,Spend|AB,C,IMP|AB,C,GRP", "|")
    For i = 0 To UBound(Flt)
        Sp = Split(Flt(i), ",")
        Select Case Sp(0)
            Case Is = "I"
                TblName = "Table1"
                C = 1
            Case Is = "T"
                TblName = "Table1"
                C = 2
            Case Is = "IB"
                TblName = "Table2"
                C = 1
            Case Is = "TB"
                TblName = "Table2"
                C = 2
            Case Is = "AB"
                TblName = "Table3"
                C = 1
        End Select
        Set ClmRng = Worksheets("Competitive Set").ListObjects(TblName).DataBodyRange.Columns(C)

        DeleteSingles ClmRng, Columns(Sp(1)).Column, Sp(2)
    Next i
End Sub

Private Sub DeleteSingles(ClmRng As Range, _
                          C As Long, _
                          Sht As String)

    Dim Fnd As Range
    Dim IsInArray As Long
    Dim lastRow As Long, R As Long

    With Sheets(Sht)
        lastRow = .Cells(Rows.Count, C).End(xlUp).Row
        For R = lastRow To 2 Step -1
            With ClmRng
                Set Fnd = .Find(What:=.Cells(R, C).Value, _
                           After:=.Cells(.Cells.Count), _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           MatchCase:=False)
            End With
            If Fnd Is Nothing Then .Rows(R).EntireRow.Delete

            If (R Mod 25 = 0) or (R = 2) Then
                Application.StatusBar = Round(((lastRow - R) / lastRow) * 100, 0) & "% done"
            End If
        Next R
    End With
End Sub

请注意，进度显示在屏幕左下方的状态栏中。

子被多次调用时速度变慢

1 个答案: