需要内部调试，运行时错误1004 Excel VBA搜索框筛选器

Question

[编辑]

我正试图在excel文件上获得一个正在运行的搜索栏。这样做的原因是为了让它对用户友好。预期的结果是使用单选按钮，键入关键字，然后让它只向上拉/筛选该结果。

Excel屏幕截图

这是我一直犯的错误，无论我改变什么。错误代码

代码：

Sub SearchBox()
'PURPOSE: Filter Data on User-Determined Column & Text
'SOURCE: www.TheSpreadsheetGuru.com
Dim myButton As OptionButton
Dim MyVal As Long
Dim ButtonName As String
Dim sht As Worksheet
Dim myField As Long
Dim DataRange As Range
Dim mySearch As Variant

'Load Sheet into A Variable
Set sht = ActiveSheet
'Unfilter Data (if necessary)
On Error Resume Next
sht.ShowAllData
On Error GoTo 0

'Filtered Data Range (include column heading cells)
'Set DataRange = sht.Range("A6:Y1000") 'Cell Range
Set DataRange = sht.ListObjects("Sheet1").Range 'Table
'Retrieve User's Search Input
mySearch = Sheets("Sheet1").TextBox1.Text 'Control Form
'mySearch = sht.OLEObjects("UserSearch").Object.Text 'ActiveX Control
'mySearch = sht.Range("A1").Value 'Cell Input
'Loop Through Option Buttons
For Each myButton In ActiveSheet.OptionButtons
If myButton.Value = 1 Then
ButtonName = myButton.Text
Exit For
End If
Next myButton

'Determine Filter Field
On Error GoTo HeadingNotFound
myField = Application.WorksheetFunction.Match(ButtonName, DataRange.Rows(1), 0)
On Error GoTo 0

'Filter Data
DataRange.AutoFilter _
Field:=myField, _
Criteria1:="=*" & mySearch & "*", _
Operator:=xlAnd

'Clear Search Field
Sheets("Sheet1").TextBox1.Text = "" 'Control Form
'sht.OLEObjects("UserSearch").Object.Text = "" 'ActiveX Control
'sht.Range("A6").Value = "" 'Cell Input
Exit Sub
'ERROR HANDLERS
HeadingNotFound:
MsgBox "The column heading [" & ButtonName & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"

End Sub

我已经对这个代码进行了几次调整，相信它在逻辑上是有意义的。我觉得它只需要小的调试就可以工作，但我不知道该更改什么来克服运行时错误1004。这可能与我所分配的文本框有关，但我对vba或excel的理解不够，不知道该更改什么。

有人足够了解excel/vba，愿意为我调试吗？

Excel的Filebin+损坏的宏

Answer 1

这对我有效。

必须使用选项按钮文本的确切列标题是很尴尬的，所以有一个函数可以在两者之间进行映射。

Option Explicit
Sub SearchBox()

Dim myButton As OptionButton
'Dim MyVal As Long
Dim header As String
Dim sht As Worksheet
'Dim myField As Long
Dim DataRange As Range
Dim mySearch As Variant, m, optText

Set sht = ActiveSheet

With sht.ListObjects("Table1")
Set DataRange = .Range
.AutoFilter.ShowAllData
End With

mySearch = Trim(ActiveSheet.TextBox1.Text)
If Len(mySearch) = 0 Then Exit Sub 'no search term

For Each myButton In sht.OptionButtons
If myButton.Value = 1 Then
optText = myButton.Text
Exit For
End If
Next myButton

header = GetHeader(optText) 'map option button to a column
If Len(header) = 0 Then
MsgBox "Could not map option button text '" & optText & "' to column header"
Exit Sub
End If

m = Application.Match(header, DataRange.Rows(1), 0) 'no WorksheetFunction
If Not IsError(m) Then
DataRange.AutoFilter Field:=m, Criteria1:="=*" & mySearch & "*", Operator:=xlAnd
Else
'm is an error value, so there was no match
MsgBox "The column heading [" & header & "] was not found in cells " & DataRange.Rows(1).Address & ". " & _
vbNewLine & "Please check for possible typos.", vbCritical, "Header Name Not Found!"
End If

End Sub
'Map your option button text to a column header in your table
'  so you can use different text for your option buttons
Function GetHeader(optText)
Select Case optText
Case "School email": GetHeader = "Enter your group member's school email you are evaluating."
Case "Name": GetHeader = "Name"
Case "Class code": GetHeader = "What is the class code this is for? (ex: INFO SCI 410)"
End Select
End Function