[решено] Excel Выбрать записи по заданному столбцу с другого листа

[surgutfred]

Есть таблица с множеством записей.
Примерную структуру приложил в примере.
На первом листе Данные Исходный набор данных. Меня интересует Столбец Имя. Данные в столбце не уникальны, повторяются.
Мне нужно по условиям отбора на втором листе отфильтровать в данных те строки которые содержат условия отбора.
В данном файле всего два условия отбора, но их может быть пару десятков.
На третьем листе Пример что хочу получить.

Пробовал через Данные - Фильтр -Дополнительно
Что то не получается.

[a_axe]

surgutfred, на форуме обсуждалась похожая тема с удобным решением 2010 - [решено] Фильтр таблицы по стороннему столбцу с данными Excel пост 7 (http://forum.oszone.net/post-2645169-7.html).
Посмотрите, если решение вас не устроит или появятся вопросы - отпишитесь.

[surgutfred]

a_axe, это удобно когда у тебя 2-3 условия для фильтра, а у меня список условий для отбора до 100 может быть, данный инструмент не удобен

[a_axe]

у меня список условий для отбора до 100 может быть, данный инструмент не удобен »
surgutfred, тут важно пояснить, какой функционал нужно адаптировать, чтобы решения стало удобным. Если вопрос только в количестве фильтров - возьмите ваш файл пример, нажмите сочетание alt+f11 для открытия VBA редактора, в "дереве проекта" найдите ярлычок Лист2(Условия), дважды щелкните по нему, чтобы в основном окне открылось его содержимое (белый лист). Скопируйте туда код ниже (чуть-чуть адаптированная версия кода из указанной темы). Вбейте в список листа "Условия" новое имя (пустых строчек быть не должно, имена должны идти подряд). Листы должны быть названы в соответствии с вашим примером.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A2").Resize(Range("A2").CurrentRegion.Columns.Item(1).Rows.Count-1)) Is Nothing Then
On Error Resume Next
Sheets.Item("Данные").ShowAllData
Sheets.Item("Данные").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
End If
End Sub

[surgutfred]

a_axe, Спасибо, то что нужно, только вместо Sheets.Item("Данные"). сделал Sheets(1).Range("A1") т.к. имя листа постоянно по дате меняется.
Единственное неудобство, когда очищаешь условие отбора, он задумывается в попытке обработать, курсор крутится. Esc спасает, но может есть вариант не обрабатывать событие, если нет введенных условий?

[a_axe]

вариант не обрабатывать событие, если нет введенных условий? »
Не обрабатывать пустой диапазон можно, но тогда не ясно, по какому событию на листе Данные будет убран фильтр.
В коде ниже фильтр убирается, если в А2 вбить значение "Все", пробуйте.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shtObj As Worksheet
Set shtObj = Sheets.Item(1)
If Not Intersect(Target, Range("A2").Resize(Range("A2").CurrentRegion.Columns.Item(1).Rows.Count - 1)) Is Nothing And Range("A1").CurrentRegion.Rows.Count > 1 Then
On Error Resume Next
shtObj.ShowAllData
shtObj.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("A1").CurrentRegion
End If
If LCase(Range("A2").Value) = "все" Then shtObj.ShowAllData
Set shtObj = Nothing
End Sub

[surgutfred]

a_axe, спасибо, тогда проще ESC жать