搜索框過濾表的VBA代碼

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 

但是，這是行不通的。有文字和數字在區域，而這僅是過濾文本，而不是數字...

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的有關範圍的分配新建分配FY點也應注意非空行，你可能使用文本框的AfterUpdate事件而不是Change事件。

UPDATE這可能適用於處理混合的數值/文本值的情況。可能有更好的方法來做到這一點，但我沒有看到明顯的解決方案。該自動篩選意味着與或文本或號碼，但不是兩個。所以這試圖將數值轉換爲字符串表示。您可能需要在其他地方做出改變，如果數值在公式引用等

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