VBA Excel - Как исправить код для фильтра в форме списка - PullRequest
1 голос
/ 27 апреля 2019

Я хотел создать фильтр в текстовом поле формы, которая возвращает результаты поиска.Поиск отлично работает.Мой код для фильтра возвращает ошибку времени выполнения, когда я делаю запись в текстовом поле.Может кто-нибудь помочь с фильтром кода?Я хочу фильтровать только финансовый год, введенный в текстовое поле, т.е.Я перечислил имена всех элементов, участвующих в коде ниже.

Вот все элементы.

  1. Форма VBA: "frmGLSearch" (Имя формы);
  2. Форма VBA TextBox: "EnterGL" (TextBox);3)
  3. Кнопка формы VBA: «Поиск» (кнопка);
  4. Форма VBA TextBox: «Фильтр» (TextBox);
  5. VBA Form ListBox: "GLResult" (ListBox);
  6. Рабочий лист: «Общий поиск» (вкладка с именованным диапазоном и динамическим поиском);
  7. Рабочий лист: «Данные» (исходные данные);
  8. Рабочий лист: «Общие» (вкладка с кнопкой поиска);
  9. Именованный диапазон: «Общий поиск» (Диапазон имен включенвкладка Общий поиск с формулой смещения)

- код 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

1 Ответ

0 голосов
/ 28 апреля 2019

Поскольку GLResult заполняется свойством RowSource, сбросьте его перед очисткой.

GLResult.RowSource = ""
Me.GLResult.Clear
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...