Помогите исправить макрос-фильтр в Экселе!

У меня есть лист Отчеты , на нем формируется весь архив данных. Есть лист Отчеты Фильтр, на нем формируется только отфильтрованный архив данных. В верхнем углу есть ячейки для поиска, в которые нужно ввести значения , и снизу под желтой линией данные будут подтягиваться с листа Отчет отфильтрованные по заданным параметрам. Напишите макрос на это или можете использовать формулы. Я не могу использовать стандартный фильтр Экселя, мне нужен именно такой интерфейсный фильтр.

Мне нужно сделать фильтр в Экселе с помощью макроса. У меня есть ячейки для ввода значений фильтрации. Макрос должен принимать эти значения идти в лист Отчеты и находить совпадения по значениям в определенных столбцам ячеек. Если таковы имеются сохарнить в список и распечатать список на листе Отчеты Фильтр в одном столбце Есть ячейка БЕ Есть ячейка МТР
Есть ячейка класс МТР Есть ячейка дата поставки
в них вводятся значения для фильтрации. Эти значения берет макрос идет в другой лист Отчеты искать совпадения. Фильтрация может проиходить по одному столбцу так и по всем сразу. Все данные должны совпадать на уровне одной строчке.
То есть если есть такой БЕ, то его МТР должен быть равен введеному МТР, класс МТР тоже должен быть равен введеному классу МТР, дата поставки должна быть равно введеной дате поставки. Фильтровать можно по разным полям одновременно , а также только по одному любому Если совпадения найдены, мне нужно все валидные строки сохранить в список
и на листе Отчеты Фильтр распечатать их

Может так понятнее будет

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

Отчет

Отчет Фильтр

Исправьте фильтр, пожалуйста!


Ответы (0 шт):