Макрос для фильтрации нескольких столбцов и между значениями - PullRequest
0 голосов
/ 17 февраля 2020

У меня есть такая таблица

enter image description here

, и я хочу отфильтровать базу по этим критериям

  1. VAlue = между 2000 и 3000
  2. Status = 'FALSE'

становятся такими, фильтр по столбцу F & G

enter image description here

и это мой код

Dim LastRow As Long
Dim i, Hide, popup  As Long
Dim message  As String
Dim LRow As Long
Dim sht As Worksheet
ActiveSheet.AutoFilterMode = False
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False
   Columns("O:R").EntireColumn.Delete
    Range("O:R").EntireColumn.Insert
    Range("F1").Value = "PO sTATUS"
    Range("G1").Value = "Value"

Set sht = ActiveSheet
LastRow = sht.Range("B" & Rows.Count).End(xlUp).Row



With sht.Range("F1:F" & LastRow)
    .Formula = "=B1"
   .Value = .Value
    .AutoFilter field:=1, Criteria1:="FALSE"
  End With

With sht.Range("G1:G" & LastRow)
    .Formula = "=D1"
   .Value = .Value
 .AutoFilter field:=1, Criteria1:=">=2000", Operator:=xlAnd, Criteria2:="<=3000"

   End With 

и этот код всегда показывает только строку 1 без значений enter image description here

1 Ответ

1 голос
/ 17 февраля 2020

Попробуйте применить фильтр сразу?

Dim LastRow As Long
Dim i, Hide, popup  As Long
Dim message  As String
Dim LRow As Long
Dim sht As Worksheet

    ActiveSheet.AutoFilterMode = False
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False
    Columns("O:R").EntireColumn.Delete
    Range("O:R").EntireColumn.Insert
    Range("F1").Value = "PO sTATUS"
    Range("G1").Value = "Value"

Set sht = ActiveSheet
LastRow = sht.Range("B" & Rows.Count).End(xlUp).Row

With sht.Range("F1:F" & LastRow)
    .Formula = "=B1"
    .Value = .Value
End With

With sht.Range("G1:G" & LastRow)
    .Formula = "=D1"
    .Value = .Value
End With

With sht.Range("F1:G" & LastRow)
    .AutoFilter
    .AutoFilter field:=1, Criteria1:="FALSE"
    .AutoFilter field:=2, Criteria1:=">=2000", Operator:=xlAnd, Criteria2:="<=3000"
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...