Суперфильтр на VBA

Стандартный Автофильтр для выборки из списков - вещь, безусловно, привычная и надежная. Но для создания сложных условий приходится выполнить не так уж мало действий. Например, чтобы отфильтровать значения попадающие в интервал от 100 до 200, необходимо развернуть список Автофильтра мышью, выбрать вариант Условие (Custom), а в новых версиях Excel: Числовые фильтры - Настраиваемый фильтр (Number filters - Custom filter). Затем в диалоговом окне задать два оператора сравнения, значения и логическую связку (И-ИЛИ) между ними:

custom_autofilter4.png

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

Шаг 1. Именованный диапазон для условий

Сначала надо создать именованный диапазон, куда мы будем вводить условия, и откуда макрос их будет брать. Для этого можно прямо над таблицей вставить пару-тройку пустых строк, затем выделить ячейки для будущих критериев (на рисунке это A2:F2) и дать им имя Условия, вписав его в поле имени в левом верхнем углу и нажав клавишу Enter. Для наглядности, я выделил эти ячейки желтым цветом:

custom_autofilter1.gif

Шаг 2. Добавляем макрос фильтрации

Теперь надо добавить к текущему листу макрос фильтрации по критериям из созданного диапазона Условия. Для этого щелкните правой кнопкой мыши по ярлычку листа и выберите команду Исходный текст (Source text). В открывшееся окно редактора Visual Basic надо скопировать и вставить текст вот такого макроса:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim FilterCol As Integer
    Dim FilterRange As Range
    Dim CondtitionString As Variant
    Dim Condition1 As String, Condition2 As String

    If Intersect(Target, Range("Условия")) Is Nothing Then Exit Sub

    On Error Resume Next
    Application.ScreenUpdating = False
    
    'определяем диапазон данных списка
    Set FilterRange = Target.Parent.AutoFilter.Range
    
    'считываем условия из всех измененных ячеек диапазона условий
    For Each cell In Target.Cells
        FilterCol = cell.Column - FilterRange.Columns(1).Column + 1
        
        If IsEmpty(cell) Then
            Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol
        Else
            If InStr(1, UCase(cell.Value), " ИЛИ ") > 0 Then
                LogicOperator = xlOr
                ConditionArray = Split(UCase(cell.Value), " ИЛИ ")
            Else
                If InStr(1, UCase(cell.Value), " И ") > 0 Then
                    LogicOperator = xlAnd
                    ConditionArray = Split(UCase(cell.Value), " И ")
                Else
                    ConditionArray = Array(cell.Text)
                End If
            End If
            'формируем первое условие
            If Left(ConditionArray(0), 1) = "<" Or Left(ConditionArray(0), 1) = ">" Then
                Condition1 = ConditionArray(0)
            Else
                Condition1 = "=" & ConditionArray(0)
            End If
            'формируем второе условие - если оно есть
            If UBound(ConditionArray) = 1 Then
                If Left(ConditionArray(1), 1) = "<" Or Left(ConditionArray(1), 1) = ">" Then
                    Condition2 = ConditionArray(1)
                Else
                    Condition2 = "=" & ConditionArray(1)
                End If
            End If
            'включаем фильтрацию
            If UBound(ConditionArray) = 0 Then
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1
            Else
                Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1, _
                    Operator:=LogicOperator, Criteria2:=Condition2
            End If
        End If
    Next cell
    
    Set FilterRange = Nothing
    Application.ScreenUpdating = True
End Sub

Все.

Теперь при вводе любых условий в желтые ячейки нашего именованного диапазона тут же будет срабатывать фильтрация, отображая только нужные нам строки и скрывая ненужные:

custom_autofilter2.gif

Как и в случае с классическими Автофильтром (Filter) и Расширенным фильтром (Advanced Filter), в нашем фильтре макросом можно смело использовать символы подстановки:

  • * (звездочка) - заменяет любое количество любых символов
  • ? (вопросительный знак) - заменяет один любой символ

и операторы логической связки:

  • И - выполнение обоих условий
  • ИЛИ - выполнение хотя бы одного из двух условий

и любые математические символы неравенства (>,<,=,>=,<=,<>).

При удалении содержимого ячеек желтого диапазона Условия автоматически снимается фильтрация с соответствующих столбцов.

P.S.

  • Если у вас Excel 2007 или 2010 не забудьте сохранить файл с поддержкой макросов (в формате xlsm), иначе добавленный макрос умрет.
  • Данный макрос не умеет работать с "умными таблицами"

Ссылки по теме

 



04.01.2013 04:54:14
Подскажите пожалуйста, а можно сделать например после фильтрации по ячейке Е4 "Сумма" автоматическую сортировку по убывания или по возрастанию?
05.01.2013 14:07:55
Добавьте перед последней строчкой макроса вот такой код:
AutoFilter.Sort.SortFields.Clear
AutoFilter.Sort.SortFields.Add Key:=Range _
        ("E4:E1403"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
With AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
End With

Только замените в нем адрес сортируемого столбца на свой.
13.01.2013 16:51:12
Можно сделать так, чтобы суперфильтр работал на "умной" ("форматировать как таблицу) екселевской таблице.
Вместо
Set FilterRange = Target.Parent.AutoFilter.Range

нужно вставить
Set FilterRange = Range("Таблица1")

"Таблица1" - имя нашей умной таблицы.
ПС, я не программист, т.ч. буду признателен, если кто проверит..
03.02.2013 13:18:55
Вася, было бы так просто - было бы здорово. Но нет - не будет работать. "Умные таблицы" - это совершенно другой объект в модели Excel, отличающийся от обычных диапазонов. Надо полностью переделывать макрос.
13.02.2013 21:10:06
Странно, я у себя сделал, всё работает. Наврное, какие-нибудь дополнительные глюки появятся, но умная "Таблица1" пока прекрасно фильтруется и сбоев не дает. Удаляешь критерий из "Условия1", фильтр сбрасывается, вставляешь - фильтруется обратно:)
03.04.2019 17:43:15
У меня работает так:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("номер ячейки, например  G2")) Is Nothing Then     '
   
   If Target.Value = "Введите текст для поиска::" Then Exit Sub  ' если пользователь ничего не ввёл, то выходим
   If Target.Value = "" Then
       Target.Value = "Введите текст для поиска:"                        ' подсказка в ячейке
       shCandidates.Range("tblSites").AutoFilter Field:=6              ' очистить фильтр (№ колонки в "умной" таблице tblSites
       Exit Sub
   End If

   With shCandidates                   ' имя листа, на котором размещена "умная" таблица        
       .Range("tblSites").AutoFilter Field:=6, Criteria1:="*" & shCandidates.Range("G2").Value & "*"       ' фильтр по подстроке
       .Range("G2").Select                                                                                                                             ' возврат фокуса в ячейку поиска/фильтра
   End With

 End If
End Sub

При необходимости фильтрации более чем по одному полю, необходимо прописать подобную процедуру для каждого из них
06.03.2013 07:57:08
А есть ли в таком фильтре возможность фильтровать столбец общей книги по дате изменений и по измненениям, внесённым каким либо конкретным пользователем?
10.03.2013 09:52:20
В таком фильтре - нет. Для такого фильтра нужно писать совершенно другой макрос.
25.03.2013 19:17:03
Здравствуйте Николай! Вы знаете все отлично работает, только вот если установить защиту листа даже при том, что все флажки отмечены как разрешить для пользователя этого листа автофильтр перестает работать. Как можно сделать так, чтобы он работал даже при защите? Буду очень признателен!
11.04.2013 10:44:24
Снимать защиту в начале макроса и ставить потом в конце перед выходом. Т.е. в 12-й строке прописать:
ActiveSheet.Unprotect Password:="123"

а после 59-й строки обратно защиту ставить:
ActiveSheet.Protect Password:="123"
12.04.2013 15:18:31
Николай Вы просто гений! Как же все просто когда все знаешь. Спасибо все работает!!
31.03.2013 00:02:22
Здравствуйте Николай!
Получаю ошибку "excpected end sub"
Что не так?
Спасибо
11.04.2013 10:40:21
Не видя вашего макроса, трудно сказать. Скорее всего - несоответствие количества закрывающих end
'ов или забыли End Sub дописать в конце макроса.
18.04.2013 07:18:02
Добрый день. Подскажите пожалуйста. Хотел сделать поиск без жесткой привязки к слову т.е. * были и вначале и в конце вводимого слова. Использовал формулу сцепить, но автоматически вывод интервала поиска не происходит. Для вывода необходимо переходить на ячейку поиска. Можно ли в макросе сделать так чтобы * добавлялись там?
07.05.2013 17:06:39
Очень интересный макрос, но вот с датами не работает.
15.05.2013 10:22:44
Николай, добрый день!
Сделал все как в Вашей инструкции. При фильтрации макрос выдает ошибку "Compile error. Syntax error." при этом сразу открывает редактор и выделяет красным 52, 53 строки макроса.

52     Target.Parent.Range(FilterRange.Address).AutoFilter Field:=FilterCol, Criteria1:=Condition1, _
53   Operator:=LogicOperator, Criteria2:=Condition2
26.05.2013 09:57:04
Копируйте текст макроса без номеров строк :)
Когда наводитесь мышью на код макроса на странице, то в правом верхнем углу появляются значки. Вам нужен крайний левый.
Или просто скачайте мой пример в заголовке статьи и возьмите код макроса оттуда.
27.05.2013 09:04:06
Да... Век живи, век учись!
Спасибо, все заработало!
29.05.2013 21:14:54
Добрый вечер! Простите за дилетантский вопрос, я только начинаю работать с VBA, почему-то при запуске макроса F5 появляется диалоговое окно, в котором макрос отсутствует, то есть запустить его не получается? Подскажите, пожалуйста, как решить эту проблему? Заранее спасибо.
31.05.2013 16:30:39
Прочитайте внимательно статью - этот макрос нужно скопировать не в обычный модуль, а в модуль листа (правой кнопкой мыши по ярлычку листа - Исходный текст).
04.06.2013 23:13:34
Николай! Огромное Вам спасибо, все работает! Проект Планета excel - просто гениальнейший !!))
12.07.2013 12:14:35
Добрый день! Возможно ли изменить макрос, чтобы фильтр выполнялся без ввода звездочек? Интересует только поиск по принципу ячейка содержит введенный текст.
01.08.2013 22:36:33
Звездочки вводятся вручную, не хотите - не ставьте :)
12.08.2013 14:51:56
Без звездочек фильтр работает только по полному соответствию, а необходимо "отфильтровать" по принципу "Текст содержит...". В Excel 2013 приходится проставлять звездочки до искомого слова и после.
24.08.2013 20:56:24
Добрый день!

ИЛИ - выполнение хотя бы одного из двух условий
а возможно сделать выполнение нескольких условий?

январь или март или *брь
20.09.2013 17:08:23
Всем добрый день, в особенности Вам Николай!
Скрипт и вправду достоин множественных похвал,
но к делу...
Видимо, выражу общую заинтересованность отписавшихся выше Alex3004, Андрей Терещенко, а также свою в следующем вопросе:
Как возможно доработать макрос Фильтра, до макроса Поиска по определённым колонкам прайс-листа?

На данный момент макрос может выполнять функцию поиска при условии, что перед искомым текстом, а также после него будут поставлены символы подстановки *(звездочка). Поиск будет производится по колонке, в которой и ввели запрос.

А хотелось бы, чтобы всё осталось точно также, НО:
- чтобы звездочки вручную ставить не пришлось(т.е. немного обмануть макрос, чтоб он думал, что * уже стоят);
- чтобы текст искал не только по своей колонке, а ещё и по нескольким соседним колонкам.

Тогда, выделив всего одну ячейку под будущие критерии, и дав ей имя Условие, можно будет Искать введенные значения во 2,3,4 колонках (расширив в три раза диапазон данных списка).

Заранее очень признателен за Ваш ответ, понимая, что макрос может быть подвергнут значительным изменениям, что потребует некоторых усилий.
26.10.2013 22:41:50
добрый вечер, есть вопрос по этому макросу,

когда он один на листе, работает прекрасно, но в сочетание с несколькими макросами или этот не работает, или другие, в зависимости в каком порядке ставлю... ни как не могу понять в чём дело.

зарание спасибо.:)  
28.10.2013 09:33:10
Замените в 8-й строке макроса команду завершения Exit Sub на оператор безусловного перехода GoTo к следующему макросу в вашем наборе.
If Intersect(Target, Range("Условия")) Is Nothing Then GoTo 1
...
...
1:
тут начинается следущий макрос
12.11.2013 13:12:40
Николай здравствуйте, подскажите ,на примере данной таблицы, как изменить макрос чтобы было так:
например мы ввели фильтрацию по нескольким условиям(овощи,январь, Москва), выдались результаты...фамилии разные, но нам еще нужно, если нашелся Петров , то выдать все данные Петрова ниже, а не только по данному фильтру, и также со всеми фамилиями.
13.11.2013 10:03:41
Виктория, вам нужен не фильтр, а сводная таблица.
13.11.2013 10:15:03
Спасибо большое, посмотрю.
18.11.2013 22:49:42
Здравствуйте Николай.
Фильтр ОЧЕНЬ удобный. А можно ли сделать так что бы он искал не точно введенное значение, а все ячейки которые содержат введенный фрагмент?
Спасибо!
04.12.2013 08:55:20
Николай, добрый день!

Спасибо за умный макрос!

У меня такая задачка.
В моем файле 4 выпадающих списка.
В именованном диапазоне "Условия" у меня только один параметр ">0", который установлен по умолчанию и меняться не будет.
Что необходимо поменять/дописать в макросе, чтобы фильтрация осуществлялась автоматически каждый раз при выборе данных в любом из выпадающих списков?
29.01.2014 21:00:41
Здравствуйте Николай! Хороший макрос, спасибо! Как сделать, чтобы в одной ячейке мог обработаться двойной запрос "содержит", т.е. ввел в одну ячейку через пробел:
запрос1 запрос2 а обработался как *запрос1* и *запрос2* (нужно для столбцов B и С)?
Методом проб и ошибок заменил в строке 38 и 45  "=" на "*" , запрос стал обрабатываться со звездочкой, а как сделать его двойным?
19.07.2014 11:06:34
Попробуйте прикрутить к своей таблице тогда лучше расширенный фильтр с автозапуском с помощью макроса.
11.02.2014 12:25:48
Подскажите, пожалуйста, у меня макрос ругается :) Пишет такую фразу: Run-time error '1004' Method 'Range' of object'_Worksheet' faled
Что ему не нравится?
19.07.2014 11:07:05
Не видя файла сказать не смогу :(
18.06.2014 09:22:44
Еще раз спасибо за макрос.
Столкнулся с проблемой:
при вставке/удалении/очистке столбца в пределах именованного диапазона Эксель зависает,
я так понимаю, что макрос запускается и зацикливается.
Нельзя-ли это исправить?
16.07.2014 11:20:54
Спасибо за интересное решение!
Подскажите как изменить макрос чтобы один столбец накладывать более 2 условий ?
03.06.2016 10:15:04
Николай,добрый день! Не надеюсь на ответ, но все же верю!!! У меня на листе в Worksheet_Change работают макросы, которые при добавлении,или удалении текста меняют цвет строки. Если я добавляю Ваш ЗАМЕЧАТЕЛЬНЫЙ код первым, то мои макросы перестают работать. Если же последним, то работают мои макросы, а этот нет.... Помогите, пожалуйста решить проблему!!! Буду очень благодарен!!! Или может кто знает суть проблемы?
12.11.2014 10:53:24
Добрый день!
Классный макрос, но хотелось бы узнать можно ли его изменить так, чтобы условия вводить в одном столбце, но в разных строках, а фильтр работал по скрытым столбцам с этими данными?
15.11.2015 06:47:17
Добрый день, Николай!

Огромное Вам спасибо за Вашу работу! Бесконечно Вам благодарен Вам за те знания, которые я получаю у Вас на сайте!

Скажите, пожалуйста, а возможно ли модифицировать данный макрос до возможности фильтровать данные по условиям заданным в разных столбцах ?

Проблему конечног может решить макрос из темы "Расширенный фильтр и немного магии", но он  не обладает возможностью текущего (задавать несколько условий для одного поля в одной ячейке используя операторы и/или)


Вот если бы возможности каждого из макросов "скрестить", то мы получим 100% идеалный фильтр ::)
Спасибо!
03.06.2016 10:11:35
Николай,добрый день! Не надеюсь на ответ, но все же верю!!! У меня на листе в Worksheet_Change работают макросы, которые при добавлении,или удалении текста меняют цвет строки. Если я добавляю Ваш ЗАМЕЧАТЕЛЬНЫЙ код первым, то мои макросы перестают работать. Если же последним, то работают мои макросы, а этот нет.... Помогите, пожалуйста решить проблему!!! Буду очень благодарен!!! Или может кто знает суть проблемы?
07.07.2016 14:08:21
Здравствуйте Николай, не могу понять почему но в одних страницах фильтр работает, а на других не хочет (((
13.09.2016 17:27:28
Большое спасибо за суперфильтр ))
Есть вопрос:
данные в фильтруемую ячейку попадают по ссылке. И для того, чтобы фильтр обновился, необходимо обязательно поставить туда мышку и нажать enter. иначе данные не обновляются.
Подскажите, пожалуйста, возможно ли это сделать автоматическим и как?)

Заранее благодарю еще и за это)
17.12.2016 12:09:49
Почему не написано, что нужно сделать автофильтр для таблицы и только после этого макрос начнёт работать?
03.02.2017 20:12:15
Приветствую Всех!
Подскажите, из-за чего Суперфильтр работает частично?
Я ВСЕ СДЕЛАЛ как написано на Статье.
- Создал "Именованный диапазон для условий"
- Добавил "Макрос Фильтрации".
Пользуюсь Англ. версией Mic Office, При клике на ярлык Листа, не нашел пункт Исходный текст/Source text, поэтому Использовал
пункт "View Code".
- Файл сохранил как .xlsm

Но, непонятно почему, Фильтр работает частично. Он не фильтрует Значения в формате Number Decimal.
На скринах видно.



И после, попытка отфильтровать данные Number Decimal


Надеюсь на Вашу помощь! Потому что Сам не смог понять Причину такого Бага.

Может надо что-то дописать, или изменить в самом Макросе...
Хотя в примере есть же - КОЛОНКИ с числовыми данными, которые фильтруются.
04.02.2017 00:53:52
Николай, пожалуйста, подскажите из-за чего фильтр не отбирает данные, что на скрине.
Я уже выделял колонки и ставил формат - General и всеравно не отибрает данные Decimal, только целые отбирает. Если фильровать к 3 4 5 и так далее, а если фильтровать 2,32 2,45 3,33 просто "схловывает" базу (как на скрине)
Спасибо за помощь.
Николай, добрый день!

Очень классный макрос!

Подскажите пожалуйста:
-  после защиты листа (ActiveSheet.Protect Password:="123"), на защищенном листе перестает работать текстовый автофильтр (даже если перед  защитой вручную ставить "использование автофильтра на защищенном листе", он почему то ее сбрасывает). Как макросу дать понять, что бы при защите он не блокировал использование автофильтра? Заранее благодарю!
15.02.2018 08:23:14
Добрый день Николай! Классный макрос спасибо! Только у меня проблема, как сделать так, чтобы диапазон для выборки был на отдельном листе?
15.02.2018 11:59:34
Насколько я помню, расширенный фильтр не работает с разными листами :(
08.04.2019 20:13:50
В Excel 2016 на Маке не работает.
Что нужно изменить?
Подскажите пожалуйста, очень нужно
04.11.2018 11:23:02
Добрый день, друзья!
Скажите, можно как-либо через макрос реализовать функцию, аналогичную FILTER в google sheets?
11.07.2019 13:49:23
Добрый день! спасибо за макрос!
Подскажите, пожалуйста, можно ли в одной ячейке указывать более двух условий?
Судя по экспериментам, которые я проводила, более двух условий не работают.
Дело в том, что мне необходимо в текстовых полях искать различные словосочетания в нескольких комбинациях ИЛИ и И
Быть может есть другой способ для поиска?
Заранее спасибо за ответ
Наверх