VBA Excel - 如何修复列表框表单上的过滤器代码
VBA Excel - How to fix code for filter on list box form
我想在 returns 搜索结果的表单文本框中创建一个过滤器。搜索效果很好。当我在文本框中输入内容时,我的过滤器代码 returns 出现 运行 时间错误。有人可以帮忙过滤代码吗?我只想过滤文本框中输入的会计年度,即 FY18。我在下面列出了代码中涉及的所有元素的名称。
这里是所有元素。
- VBA 表格:"frmGLSearch"(表格名称);
- VBA 表单文本框:"EnterGL" (TextBox); 3)
- VBA 表单按钮:"Search"(按钮);
- VBA 表单文本框: "Filter" (TextBox);
- VBA 表单列表框: "GLResult" (ListBox);
- 工作表:"General Search"(带有命名范围和动态搜索的选项卡);
- 工作表:"Data"(源数据);
- 工作表:"General"(带搜索按钮的选项卡);
- 命名范围:"GeneralSearch"(“名称范围”选项卡上的“常规搜索”
抵消公式)
--VBA 在表单上使用文本框进行过滤的代码--
Private Sub Filter_Change()
Dim i As Long
Dim arrList As Variant
Me.GLResult.Clear
If Worksheets("General Search").Range("A" & Worksheets("General Search").Rows.Count).End(xlUp).Row > 1 And Trim(Me.Filter.Value) <> vbNullString Then
arrList = Worksheets("General Search").Range("A1:A" & Worksheets("General Search").Range("A" & Worksheets("General Search").Rows.Count).End(xlUp).Row).Value2
For i = LBound(arrList) To UBound(arrList)
If InStr(1, arrList(i, 1), Trim(Me.Filter.Value), vbTextCompare) Then
Me.GLResult.AddItem arrList(i, 1)
End If
Next i
End If
If Me.GLResult.ListCount = 1 Then Me.GLResult.Selected(0) = True
End Sub
---追加VBA----
Option Explicit
Private Sub Search_Click()
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 2
SearchRow = 2
Worksheets("Data").Activate
Do Until Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 2).Value, EnterGL.Value, vbTextCompare) > 0 Then
Worksheets("General Search").Cells(SearchRow, 1).Value = Cells(RowNum, 1).Value
Worksheets("General Search").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("General Search").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("General Search").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
Worksheets("General Search").Cells(SearchRow, 5).Value = Cells(RowNum, 5).Value
Worksheets("General Search").Cells(SearchRow, 6).Value = Cells(RowNum, 6).Value
Worksheets("General Search").Cells(SearchRow, 7).Value = Cells(RowNum, 7).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "GL not found"
Exit Sub
End If
GLResult.RowSource = "GeneralSearch"
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
EnterGL.SetFocus
Worksheets("General Search").Range("A2:G25000").ClearContents
End Sub
由于 GLResult
由 RowSource
属性 填充,请在清除前重置它。
GLResult.RowSource = ""
Me.GLResult.Clear
我想在 returns 搜索结果的表单文本框中创建一个过滤器。搜索效果很好。当我在文本框中输入内容时,我的过滤器代码 returns 出现 运行 时间错误。有人可以帮忙过滤代码吗?我只想过滤文本框中输入的会计年度,即 FY18。我在下面列出了代码中涉及的所有元素的名称。
这里是所有元素。
- VBA 表格:"frmGLSearch"(表格名称);
- VBA 表单文本框:"EnterGL" (TextBox); 3)
- VBA 表单按钮:"Search"(按钮);
- VBA 表单文本框: "Filter" (TextBox);
- VBA 表单列表框: "GLResult" (ListBox);
- 工作表:"General Search"(带有命名范围和动态搜索的选项卡);
- 工作表:"Data"(源数据);
- 工作表:"General"(带搜索按钮的选项卡);
- 命名范围:"GeneralSearch"(“名称范围”选项卡上的“常规搜索” 抵消公式)
--VBA 在表单上使用文本框进行过滤的代码--
Private Sub Filter_Change()
Dim i As Long
Dim arrList As Variant
Me.GLResult.Clear
If Worksheets("General Search").Range("A" & Worksheets("General Search").Rows.Count).End(xlUp).Row > 1 And Trim(Me.Filter.Value) <> vbNullString Then
arrList = Worksheets("General Search").Range("A1:A" & Worksheets("General Search").Range("A" & Worksheets("General Search").Rows.Count).End(xlUp).Row).Value2
For i = LBound(arrList) To UBound(arrList)
If InStr(1, arrList(i, 1), Trim(Me.Filter.Value), vbTextCompare) Then
Me.GLResult.AddItem arrList(i, 1)
End If
Next i
End If
If Me.GLResult.ListCount = 1 Then Me.GLResult.Selected(0) = True
End Sub
---追加VBA----
Option Explicit
Private Sub Search_Click()
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 2
SearchRow = 2
Worksheets("Data").Activate
Do Until Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 2).Value, EnterGL.Value, vbTextCompare) > 0 Then
Worksheets("General Search").Cells(SearchRow, 1).Value = Cells(RowNum, 1).Value
Worksheets("General Search").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("General Search").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("General Search").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
Worksheets("General Search").Cells(SearchRow, 5).Value = Cells(RowNum, 5).Value
Worksheets("General Search").Cells(SearchRow, 6).Value = Cells(RowNum, 6).Value
Worksheets("General Search").Cells(SearchRow, 7).Value = Cells(RowNum, 7).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "GL not found"
Exit Sub
End If
GLResult.RowSource = "GeneralSearch"
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
EnterGL.SetFocus
Worksheets("General Search").Range("A2:G25000").ClearContents
End Sub
由于 GLResult
由 RowSource
属性 填充,请在清除前重置它。
GLResult.RowSource = ""
Me.GLResult.Clear