Отфильтровать строки по трем столбцам (для каждого свой параметр)

[ac1-caesar]

Уважаемые форумчане!

Пожалуйста подскажите, как отфильтровать строки в таблице по по трем столбцам (для каждого свой параметр). Условие: значение должно быть меньше или равно заданного параметра.
Есть таблица значений в ней 3 столбца ("значение 1", "значение 2", "значение 3") с числовыми значениями.
Есть 3 параметра для фильтрации ("Параметр 1" - для столбца "значение 1", "Параметр 2" - для столбца "значение 2", "Параметр 3" - для столбца "значение 3").
К примеру мы задали Параметр 1 = 150, Параметр 2 = 520, Параметр 3 = 390.
В таблице значений строке номер 6 есть 3 значения - значение 1 = 251, значение 2 = 436, значение 3 = 394.
При фильтрации эта строка попадает в заданный диапазон так как "значение 2" меньше "Параметр 2".

В таблице значений строке номер 8 есть 3 значения - значение 1 = 277, значение 2 = 757, значение 3 = 650.
При фильтрации эта строка не попадает в заданный диапазон, так как значения 1, 2, 3 превышают параметры 1, 2, 3.
P.S. Строка с нулевыми значениями 1, 2, 3 должна игнорироваться.

Использую код с одним параметром для 3-х столбцов. Подкорректируйте или подскажите как подключить 3 параметра.

Sub test()
 
Dim r As Long, c As Long, i As Long, j As Long
Dim ar(), m1 As Double, m2 As Double, m As Double
Dim s As String
Dim CalculationRange As String
 
    m1 = "-1000" 'Параметр "from"
    m2 = "160" 'Параметр "to"
 
    With ThisWorkbook.Sheets("Sheet1")
        CalculationRange = "Table1[[значение 1]:[значение 3]]"
        s = "=SumProduct((" & .Range(CalculationRange).Address & ">=" & m1 & ")*(" & .Range(CalculationRange).Address & "<=" & m2 & "))"
        i = Application.Evaluate(s)
         
        If i = 0 Then
          Exit Sub
        End If
         
        ReDim ar(1 To i, 1 To 5)
        i = 0
        r = .Range(CalculationRange).Row
        c = .Range(CalculationRange).Column
         
        For r = r To r + .Range(CalculationRange).Rows.Count - 1
            m = Application.Min(.Cells(r, c).Resize(1, 3))
            If WorksheetFunction.Count(.Cells(r, c).Resize(1, 3)) = 0 Then m = 1 + Abs(m1) + Abs(m2)
             
            If (m - m1) * (m - m2) <= 0 Then
                i = i + 1
                ar(i, 1) = .Cells(r, 1) 'number
                ar(i, 2) = .Cells(r, 2) 'Description
            End If
             
            For j = 1 To 3
              If .Cells(r, c + j - 1) = m Then ar(i, j + 2) = m
            Next j
        Next r
 
        .Cells(3, 17).Resize(UBound(ar), 5).Value = ar
    End With
End Sub

Так же эта тема, пока без развития, расположена здесь

[IgorGO]

ставите фильтр
включаете запись макроса
фильтруете что Вам нужно
анализируете полученный макрос
и пользуетесь им

удачи!

[ac1-caesar]

Нее, если я по первому столбцу поставлю фильтр <=150, то не останутся ячейки с пустыми значениями, т.е. срежутся вероятные значения второго и третьего столбца.

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<=150"

Если в условии задать чтобы и пустые значения оставлять

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<=150", Operator:=xlOr, Criteria2:="="

то будут оставаться строки с 3-мя пустыми значениями в 3-х столбцах

[ac1-caesar]

При таком варианте

With ActiveSheet.ListObjects("Table1").Range
    .AutoFilter Field:=3, Criteria1:="<=150", Operator:=xlOr, Criteria2:="="
    .AutoFilter Field:=4, Criteria1:="<=520", Operator:=xlOr, Criteria2:="="
    .AutoFilter Field:=5, Criteria1:="<=390", Operator:=xlOr, Criteria2:="="
End With

не включены номера 6, 11, 15, 27
и включены номера 7, 10, 13, 18, 23, 26 с пустыми значениями

Думаю простым фильтром не обойдется дело...

[ac1-caesar]

Изменил конструкцию

Sub test1()

Dim r As Long, c As Long, i As Long
Dim ar(), Parameter1 As Double, Parameter2 As Double, Parameter3 As Double, CellValue1, CellValue2, CellValue3
Dim s As String
Dim CalculationRange1 As String, CalculationRange2 As String, CalculationRange3 As String

    With ThisWorkbook.Sheets("Sheet1")
        Parameter1 = .Cells(3, 7).Value
        Parameter2 = .Cells(3, 8).Value
        Parameter3 = .Cells(3, 9).Value
        CalculationRange1 = "Table1[значение 1]"
        CalculationRange2 = "Table1[значение 2]"
        CalculationRange3 = "Table1[значение 3]"
        s = "=SumProduct((" & .Range(CalculationRange1).Address & "<=" & Parameter1 & ")*(" & .Range(CalculationRange2).Address & "<=" & Parameter2 & ")*(" & .Range(CalculationRange3).Address & "<=" & Parameter3 & "))"
        i = Application.Evaluate(s)
        
        If i = 0 Then
          Exit Sub
        End If
        
        ReDim ar(1 To i, 1 To 5)
        i = 0
        r = .Range(CalculationRange1).Row
        c = .Range(CalculationRange1).Column
        
        For r = r To r + .Range(CalculationRange1).Rows.Count - 1
            CellValue1 = .Cells(r, c).Value
            CellValue2 = .Cells(r, c + 1).Value
            CellValue3 = .Cells(r, c + 2).Value
            
            If WorksheetFunction.Count(.Cells(r, c).Resize(1, 3)) = 0 Then CellValue1 = 1 + Abs(Parameter1): CellValue2 = 1 + Abs(Parameter2): CellValue3 = 1 + Abs(Parameter3)

            If CellValue1 <= Parameter1 And CellValue1 <> "" Or CellValue2 <= Parameter2 And CellValue2 <> "" Or CellValue3 <= Parameter3 And CellValue3 <> "" Then
                i = i + 1
                ar(i, 1) = .Cells(r, 1) 'number
                ar(i, 2) = .Cells(r, 2) 'Description
                ar(i, 3) = .Cells(r, 3) 'Value1
                ar(i, 4) = .Cells(r, 4) 'Value2
                ar(i, 5) = .Cells(r, 5) 'Value3
            End If
        Next r

        .Cells(3, 17).Resize(UBound(ar), 5).Value = ar
    End With
End Sub

Вроде работает, но не корректно вычисляет количество i для массива. Подозреваю что неверный синтаксис в этой строке: s = "=SumProduct((" & .Range(CalculationRange1).Address & "<=" & Parameter1 & ")*(" & .Range(CalculationRange2).Address & "<=" & Parameter2 & ")*(" & .Range(CalculationRange3).Address & "<=" & Parameter3 & "))"
Ну и хотел бы попросить гуру оптимизировать код, думаю есть избыточность.
Минус в конструкции - все три параметра должны быть.