Question

大家好，我在下面的代码中搜索给定列中的多个文本。问题是它很慢。人们是否知道其他任何方法可以更快地执行它？

例如，给出数组（＆＃39; foo＆＃39;，＆＃39; bar＆＃39;），代码应迭代一列，并匹配/过滤只有任何给定顺序的两个文本的行

Sub aTest()
ScreenUpdating = False

Dim selectedRange As Range, cell As Range

Dim searchValues() As String

searchValues = Split(ActiveSheet.Cells(2, 1).Value)

Set selectedRange = Range("A4:A40000")

Dim element As Variant

For Each cell In selectedRange
    If cell.Value = "" Then
        Exit For
    Else
        For Each element In searchValues
            If Not InStr(1, cell.Value, element) Then
                cell.EntireRow.Hidden = True
            End If
        Next element
    End If
Next cell

ScreenUpdating = True

End Sub

我用它作为过滤器。通过一些修改复制并粘贴以下代码。但后来我无法进行更改以匹配多个字符串。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iFilterColumn As Integer
    Dim rFilter As Range
    Dim sCriteria As String
    On Error Resume Next
    With Target
        Set rFilter = .Parent.AutoFilter.Range
        iFilterColumn = .Column + 1 - rFilter.Columns(1).Column
        If Intersect(Target, Range("rCriteria")) Is Nothing Then GoTo Terminator
        Select Case Left(.Value, 1)
        Case ">", "<"
            sCriteria = .Value
        Case Else
            sCriteria = "=*" & .Value & "*"
        End Select
        If sCriteria = "=" Then
            .Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn
        Else
            .Parent.Range(rFilter.Address).AutoFilter Field:=iFilterColumn, Criteria1:=sCriteria
        End If
    End With
Terminator:
    Set rFilter = Nothing
    On Error GoTo 0
End Sub

Answer 1

我假设：

Set selectedRange = Range("A4:A40000")

这是因为大小没有正确定义，以下内容应该限制在正确的长度

Set selectedRange = Range("A4:A" & Cells(Rows.Count, "A").End(xlUp).Row)

如果它没有影响，我总是使用这些代码来加速Excel（而不仅仅是ScreenUpdating）。

Sub ExcelNormal()
        With Excel.Application
        .Cursor = xlDefault
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .StatusBar = False
        End With
End Sub
Sub ExcelBusy()
        With Excel.Application
        .Cursor = xlWait
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
        .StatusBar = False
        End With
End Sub

注意：未来可能会Code Review发布更好的地方。

更快的多标准搜索/过滤excel

1 个答案: