Помогите исправить макрос-фильтр в Экселе!
У меня есть лист Отчеты , на нем формируется весь архив данных. Есть лист Отчеты Фильтр, на нем формируется только отфильтрованный архив данных. В верхнем углу есть ячейки для поиска, в которые нужно ввести значения , и снизу под желтой линией данные будут подтягиваться с листа Отчет отфильтрованные по заданным параметрам. Напишите макрос на это или можете использовать формулы. Я не могу использовать стандартный фильтр Экселя, мне нужен именно такой интерфейсный фильтр.
Мне нужно сделать фильтр в Экселе с помощью макроса.
У меня есть ячейки для ввода значений фильтрации.
Макрос должен принимать эти значения идти в лист Отчеты и находить совпадения по значениям в определенных столбцам ячеек.
Если таковы имеются сохарнить в список и распечатать список на листе Отчеты Фильтр в одном столбце
Есть ячейка БЕ
Есть ячейка МТР
Есть ячейка класс МТР
Есть ячейка дата поставки
в них вводятся значения для фильтрации.
Эти значения берет макрос идет в другой лист Отчеты искать совпадения. Фильтрация может проиходить по одному столбцу так и по всем сразу. Все данные должны совпадать на уровне одной строчке.
То есть если есть такой БЕ, то его МТР должен быть равен введеному МТР, класс МТР тоже должен быть равен введеному классу МТР, дата поставки должна быть равно введеной дате поставки.
Фильтровать можно по разным полям одновременно , а также только по одному любому
Если совпадения найдены, мне нужно все валидные строки сохранить в список
и на листе Отчеты Фильтр распечатать их
Может так понятнее будет
Sub FilterAndPrintMultiple()
Dim wsData As Worksheet
Dim wsReportFilter As Worksheet
Dim filterRange As Range
Dim criteriaRange As Range
Dim outputSheet As Worksheet
Dim lastRow As Long
Dim i As Long
' Установка ссылок на листы
Set wsData = ThisWorkbook.Sheets("Отчет")
Set wsReportFilter = ThisWorkbook.Sheets("Отчет Фильтр")
' Определения диапазона для фильтрации
Set filterRange = wsData.Range("I2:L" & wsData.Cells(wsData.Rows.Count, "I").End(xlUp).Row) ' Äèàïàçîí äàííûõ
' Определения критериев для фильтрации
Set criteriaRange = wsReportFilter.Range("A2:D2")
' Находим последние заполненые строки
lastRowBE = wsReportFilter.Cells(wsReportFilter.Rows.Count, "A").End(xlUp).Row
lastRowCodeMTR = wsReportFilter.Cells(wsReportFilter.Rows.Count, "B").End(xlUp).Row
lastRowCodeClassMTR = wsReportFilter.Cells(wsReportFilter.Rows.Count, "C").End(xlUp).Row
lastRowDateOfShipment = wsReportFilter.Cells(wsReportFilter.Rows.Count, "D").End(xlUp).Row
'Применяем фильтры
With filterRange.AutoFilter
.Column(1).Criteria1 = wsReportFilter.Range("A" & lastRowBE).Value
.Column(2).Criteria1 = wsReportFilter.Range("B" & lastRowCodeMTR).Value
.Column(3).Criteria1 = wsReportFilter.Range("C" & lastRowCodeClassMTR).Value
.Column(4).Criteria1 = wsReportFilter.Range("D" & lastRowDateOfShipment).Value
End With
' Сохраняем валидные строки в списки
Dim validRows As Range
On Error Resume Next
Set validRows = filterRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
'Если найдены совпадения, копируем их на лист Отчет фильтр
If Not validRows Is Nothing Then
i = wsReportFilter.Cells(wsReportFilter.Rows.Count, "A").End(xlUp).Row + 1
validRows.Copy wsReportFilter.Range("A" & i)
' Добавляем заголовки, если они нужны
wsReportFilter.Range("A11:L11").Value = Array("Поле1", "Поле2" , "Поле3" , ...)
End If
'Очищаем фильтр
filterRange.AutoFilter
End Sub
Исправьте фильтр, пожалуйста!