Question

我设计了一个搜索框，可以在将文本输入所述搜索框时过滤我的表格。问题是它太慢了，现在几乎不值得在我的工作簿中使用它。

有人能想出任何修改/改进此代码的方法吗？

这是我目前的代码：

Private Sub TextBox1_Change()
 Dim searchArea As Range, searchRow As Range, searchCell As Range
 Dim searchString As String
 Dim lastRow As Integer

 Application.ScreenUpdating = False
 searchString = "*" & LCase(TextBox1.Value) & "*"
 Rows.Hidden = False

 lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
 Set searchArea = Me.Range("f3:f791", "f3" & lastRow)
 searchArea.EntireRow.Hidden = True

 For Each searchRow In searchArea.Rows
   For Each searchCell In searchRow.Cells
     If LCase(searchCell) Like searchString Then
       searchRow.Hidden = False
       Exit For
     End If
   Next searchCell
 Next searchRow

 Application.Goto Range("Z1"), True
 ActiveWindow.ScrollColumn = 1
 Application.ScreenUpdating = True

End Sub

编辑我的代码：

Private Sub TextBox1_Change()
    ActiveSheet.ListObjects("states").Range.AutoFilter Field:=1, _
        Criteria1:="*" & [G1] & "*", Operator:=xlFilterValues
End Sub

但是，这不起作用。字段1中有文本和数字，这只是过滤文本，而不是数字......

Answer 1

这绝对是多余的，因为你的迭代是在一个列上：

 For Each searchRow In searchArea.Rows
   For Each searchCell In searchRow.Cells  '### searchRow ONLY HAS ONE CELL! This second/inner loop is totally unnecessary
     If LCase(searchCell) Like searchString Then
       searchRow.Hidden = False
       Exit For
     End If
   Next searchCell
 Next searchRow

重写为：

For Each searchCell in searchArea.Cells '## Assumes searchArea is single column
   searchCell.EntireRow.Hidden = Not (LCase(searchCell) Like searchString)
Next

仅此一项就可以提高性能，但我认为AutoFilter是一种更好的方法，您应该能够从宏记录器中获取基本代码。

这看起来像是：

searchArea.AutoFilter Field:=1, Criteria1:="=" & searchString, _
    Operator:=xlAnd, Criteria2:="<>"

这应过滤以仅显示包含searchString

的非空白行

@ Yowe3k关于范围分配的观点也应该注意，你可以使用TextBox的AfterUpdate事件而不是Change事件。

更新这可能会处理您的数字/文本值的混合情况。可能有更好的方法来做到这一点，但我没有看到明显的解决方案。 AutoFilter适用于文本或数字，但不能同时使用两者。因此，这会尝试将数值转换为字符串表示形式。如果在公式等中引用了数值，则可能需要在其他位置进行更改

Dim arr, v
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(1)
' ## Disable filter if it's on already
If tbl.Range.AutoFilter Then tbl.Range.AutoFilter
arr = tbl.DataBodyRange.Columns(1).Value
' ## Convert your range of mixed numeric/string to string
For v = LBound(arr, 1) To UBound(arr, 1)
    If IsNumeric(arr(v, 1)) Then
        arr(v, 1) = "'" & CStr(arr(v, 1))
    End If
Next
' ## Put the string data back out to the worksheet
tbl.DataBodyRange.Columns(1).Value = arr
tbl.Range.AutoFilter Field:=1, _
       Criteria1:="*" & CStr([G1]) & "*", Operator:=xlFilterValues

用于过滤表

1 个答案: