Довольно часто сталкиваюсь с необходимостью фильтра столбца таблицы по нескольким критериям. В сети нашел макрос, который преобразует выделенный диапазон ячеек в критерии для фильтра.
Код
Sub FilterMultipleCriteria()
Dim filterRange As Range, filterValues() As Variant, cl As Range, i As Integer
Set filterRange = Range("A1")
If Selection.Count > 1 Then
ReDim filterValues(Selection.SpecialCells(xlCellTypeVisible).Count - 1)
Else
ReDim filterValues(Selection.Cells.Count - 1)
i = 0
End If
For Each cl In Selection
ReDim Preserve filterValues(i)
filterValues(i) = cl.Text
i = i + 1
Next cl
Dim RowNumber As Integer
RowNumber = Val(InputBox("Row Number"))
filterRange.AutoFilter Field:=RowNumber, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub
Макрос работает не совсем корректно, а именно, неправильно фильтрует по выбранным ячейка если они уже отфильтрованы. Пример прилагаю.
Макрос слепил другой, однако проблемы с фильтрацией остались. Таблица фильтруется некорректно если выбранные ячейки с условиями уже были отфильтрованы. Добавил пример.
neqkeet написал: Макрос работает не совсем корректно, а именно, неправильно фильтрует по выбранным ячейка если они уже отфильтрованы.
Ну а что вы хотели? Фильтр не запоминает предыдущие отфильтрованные значения - это можно сделать только в экселевском интерфейсе (да и то - начиная с 2010-го офиса).
Вы открывали мой пример? Мне не нужно чтобы макрос запоминал предыдущие значения. Видимо я неправильно выразился. Макрос фильтрует некорректно если есть фильтр на другом столбце. Т.е. ячейки после фильтрации другого столбца находятся друг от друга далеко. Например, номер строки одной ячейки 10, а другой - 500. Макрос подцепляет другие значения, а не только выбранные.
JayBhagavan написал: То что надо сделать чтобы было корректно по-Вашему?
Помочь мне с кодом. Если Вы намекаете на то, что нужно снять все фильтры, то в моем случае это не решение. Таблица на которой будут применять макрос имеет около 35000 строк и 25 столбцов, и уже отфильтрована по нескольким столбцам. Каждый раз снимать и добавлять фильтр, пускай даже макросом, не вариант.
Цитата
SuperCat написал: Тогда Вам нужны Areas - именно там лежат ячейки несмежных диапазонов. Общий код такой (в принципе, он и для смежных пойдёт):
Вы не могли бы применить свою идею к моему макросу? Забыл упомянуть, что с VBA я на Вы, а макрос сверху слепил сам не пойму как из нескольких, найденных в сети.
Для того чтобы понять что не так, нужно открыть приложенный мною пример. Выделить желтые ячейки и выполнить макрос (вроде в файле присутствует). В inputbox номер столбца для фильтрации указать 3.
Как должно быть: столбец C должен отфильтроваться только по значениям выделенных ячеек. (со значениями 3223586 и 23881).
neqkeet, открыл и выполнил. Всё в порядке. Немного почистил макрос. У меня работает:
Код
Option Explicit
Sub FilterMultipleCriteria()
Dim filterRange As Range, filterValues() As Variant, cl As Range, i As Integer
Set filterRange = Range("A1")
If Selection.Count > 1 Then
ReDim filterValues(1 To Selection.SpecialCells(xlCellTypeVisible).Count)
Else
ReDim filterValues(1 To Selection.Cells.Count)
i = 0
End If
For Each cl In Selection
i = i + 1
filterValues(i) = cl.Text
Next cl
Dim ColNumber As Integer
ColNumber = Val(InputBox("COLUMN Number"))
filterRange.AutoFilter Field:=ColNumber, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
Option Explicit
Sub FilterMultipleCriteria()
Dim filterRange As Range, filterValues() As Variant, cl As Range, i As Integer, rng As Range
Set filterRange = Range("A1")
Set rng = Selection '
If rng.Cells.Count > 1 Then Set rng = rng.SpecialCells(xlCellTypeVisible)
ReDim filterValues(1 To rng.Count)
i = 0
For Each cl In rng
i = i + 1
filterValues(i) = cl.Text
Next cl
Dim ColNumber As Integer
ColNumber = rng.Column - filterRange.Column + 1 ' Val(InputBox("COLUMN Number"))
filterRange.AutoFilter Field:=ColNumber, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub
Шикарно причесали! Работает и через ctrl и при сплошном выделении. Прошу добавить 1 нюанс - выбор ячейки не по номеру столбца, а по его названию ("А", "B" и т.д.), дабы не запутаться.
Update: Первый раз лучший причесали, теперь не работает при сплошном выделении тех же строк 10 и 273. Ошибка "type mismatch"
Вы строчите код быстрее чем я сообщения). Первая версия была самая четкая. (третью я не успел попробовать). Инпутбокс нужен, т.к. не всегда фильтруюсь именно по той колонке в которой находятся необходимые значения.
neqkeet, инп.бокс не пропал. Я его закомментировал ибо мне лениво вводить номер столбца, если его можно вычислить. Просто в 15й строке удалите после равно и до Val и будет Вам счастье.