Создание функции поиска по нескольким полям в Excel VBA

Мне нужно создать связанную функцию поиска в VBA, которая также автоматически обновляется после ввода данных в заданные поля поиска. Мне удалось сделать это успешно со следующими разделами кода:

Поиск автофильтра - в стандартном модуле

Код:

Sub FilterTo1Criteria()
With Sheet3
    If Range("A3") <> vbNullString Then
        .AutoFilterMode = False
        .Range("A6:J1015").AutoFilter
        .Range("A6:J1015").AutoFilter Field:=1, Criteria1:=Range("A3")
    Else
        Selection.AutoFilter
    End If
End With
End Sub

Смена/автоматическое обновление листа — находится в модуле рабочего листа.

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$A$3" Then
        Application.EnableEvents = False
        FilterTo1Criteria
        Application.EnableEvents = True
    End If
End Sub

Однако на странице смены листа мне нужны ячейки A3: J3 в качестве критериев, но мне также нужно, чтобы функция автоматического поиска работала, если заполнены только A3 и D3 или если заполнен только A3 (D3 пуст) , или если заполнено только D3 (A3 пусто), но у меня возникают проблемы с попыткой составить код для получения этого эффекта. Насколько сложнее я должен буду сделать это? Есть ли какие-то примеры, о которых кто-то знает, на которые я могу посмотреть, чтобы почерпнуть какую-то информацию? Трудно найти какую-либо...

Слайсер со сводной таблицей — это потенциальный путь, но я думаю, что некоторые люди ниже по течению используют Excel 2003, и я не думаю, что слайсер работает так далеко.

Заранее спасибо!


person thegreataus    schedule 16.11.2016    source источник


Ответы (1)


Чтобы функция работала, если A3 или D3 не пусты, вы можете объединить две ячейки и сравнить это с vbNullString.

Для нескольких фильтров вы можете использовать цикл, чтобы установить их все.

eg:

Sub FilterTo1Criteria()
    Dim i As Long
    With Sheet3
    If Range("A3") & Range("D3") <> vbNullString Then
            .AutoFilterMode = False
            .Range("A6:J1015").AutoFilter
            For i = 1 To 10
                .Range("A6:J1015").AutoFilter Field:=i, Criteria1:=Cells(3, i)
            Next i
        Else
            Selection.AutoFilter
        End If
    End With
End Sub

Изменить:

Похоже, вы хотели установить фильтры по мере заполнения ячеек критериев, а не все сразу. Попробуйте это вместо этого:

Sub FilterTo1Criteria()
    Dim i As Long
    With Sheet3
        .AutoFilterMode = False
        .Range("A6:J1015").AutoFilter
        For i = 1 To 10
            If .Cells(3, i) <> vbNullString Then
                .Range("A6:J1015").AutoFilter Field:=i, Criteria1:=.Cells(3, i)
            End If
        Next i
    End With
End Sub

и для нового листа изменения sub:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("$A$3:$J$3")) Is Nothing Then
        Application.EnableEvents = False
        FilterTo1Criteria
        Application.EnableEvents = True
    End If
End Sub

Это добавит или удалит фильтры по мере добавления или удаления критериев (строка 3).

person bobajob    schedule 16.11.2016
comment
Спасибо! Когда я пытаюсь это сделать, он говорит, что я получаю ошибку времени выполнения «424»: требуется объект, и в режиме отладки он выделяет строку .autofiltermode = False... - person thegreataus; 16.11.2016
comment
Это не изменилось по сравнению с вашим исходным кодом... Псевдоним Sheet3 случайно не изменился? Что, если вместо этого вы обратитесь к листу по имени... - person bobajob; 16.11.2016
comment
О да. Я использовал слегка измененную копию только с одним листом, чтобы поэкспериментировать с новым кодом. Это убрало это ... но нет, когда у меня есть данные в a3 и d3 и я запускаю макрос, экран мигает, выводит немного данных на некоторое время, но затем ничего не возвращает ... - person thegreataus; 16.11.2016
comment
Определенно ли в данных есть строки, точно соответствующие строке 3? Потому что это то, что сейчас проверяют фильтры, поэтому скроет все остальное. (Это то, что вы имели в виду, говоря, что ячейки A3: J3 являются критериями, да?) - person bobajob; 17.11.2016
comment
Ах, хорошо, я, возможно, не был так ясен, как, вероятно, должен был быть. В идеале каждая ячейка в A3:J3 должна быть своего рода критерием поиска. Мне не нужно, чтобы все они были заполнены, чтобы вернуть результаты... например, если заполнена только ячейка A, которая является «Типом продукта», будет возвращен только этот точный тип. Затем, если вы перейдете к G3 и укажете, в каком городе, он вернет тип продукта в соответствующем городе со все большим количеством критериев поиска в каждой ячейке. Прямо сейчас требуется ли заполнение каждой ячейки, чтобы он возвращал результаты? - person thegreataus; 17.11.2016
comment
Святая мольба, это работает как заклинание. Можно поинтересоваться, где вы всему этому научились?? Я хотел бы иметь возможность сделать что-то из этого самостоятельно... Я изучаю python и вижу много общего с различными операторами If/Then, отступами и т. д., поэтому я думаю, что я нахожусь на правильный путь. Спасибо большое, хотя бобаджоб! - person thegreataus; 17.11.2016
comment
Рад, что это помогло. Что касается того, как я это узнал - немного логики и много гугления! Я уверен, что ты скоро поднимешь его. - person bobajob; 17.11.2016
comment
Ха-ха, наверное. Я, вероятно, собираюсь опубликовать вопрос, слегка связанный с только что предоставленным вами решением, но он добавляет немного поворота в нужную мне функцию поиска, включая даты и пытаясь выполнить все вышеперечисленные функции фильтрации, но также добавляя вытягивание в продуктах, произведенных между двумя датами. - person thegreataus; 17.11.2016
comment
Конечно, хотя, как всегда, сначала попробуйте сами. Этот сайт действительно должен быть последним средством после того, как все ваши усилия (включая поиск в Google) потерпели неудачу. - person bobajob; 17.11.2016
comment
Я согласен. Я искал тонну этого материала, и мне не удается связать вместе более сложные функции поиска. Я мог выполнять небольшие отдельные поиски в автофильтре, но соединить их все вместе было непросто. Функция поиска даты бросает огромный разводной ключ :-/ - person thegreataus; 17.11.2016