Excel VBA - IF Autofilter не содержит записей, MsgBox

Question

Я пытаюсь отфильтровать определенные критерии, в данном случае Anything Like -SERVICE CODE Я фильтрую это в имени столбца, а не в столбце, представленном A: A. Часть FIrst кода работает нормально, оператор If - это то, где у меня возникают проблемы. Я создал оператор If, чтобы иметь возможность сделать что-то, если есть фактический ряд данных, который отображается для фильтра -SERVICE CODE, в этом случае он должен показывать «Данные», если есть хотя бы одна строка, которая фильтруется, проблема в том, что он показывает сообщение «Данные», даже если нет ничего, что показано при фильтрации.

Я пытаюсь выяснить, как получить Msg of No Data, чтобы показывать правильно, когда нет ничего, что соответствует критериям фильтра.

Спасибо,

Sub Filter results() 

Dim rng As Range, res As Variant 

Set rng = ActiveSheet.AutoFilter.Range.Rows(1) 
res = Application.Match("Errors", rng, 0) 
rng.AutoFilter Field:=res, Criteria1:="*-SERVICE CODE*" 

If rng.SpecialCells(xlCellTypeVisible).Count > 1 Then 
    MsgBox "Data" 
Else 
    MsgBox "No Data" 
End If 

End Sub() 

Answer 1

Используя код, я определил последнюю строку использованного диапазона (при условии, что всегда есть данные в столбце A, переключитесь на другой с olumn if not), поскольку любые ячейки за последней строкой будут отображаться как видимые. Затем видимый счетчик выполняется только в этом столбце до последней строки.

Sub FilterResults() 

Dim rng As Range, res As Variant, lrow As Long 

Set rng = ActiveSheet.AutoFilter.Range.Rows(1) 
res = Application.Match("Errors", rng, 0) 
rng.AutoFilter Field:=res, Criteria1:="*-SERVICE CODE*" 

lrow = ActiveSheet.Cells(Rows.Count, res).End(xlUp).Row + 1 

If ActiveSheet.Range(Cells(1, res), Cells(lrow, res)).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then 
    MsgBox "Data" 
Else 
    MsgBox "No Data" 
End If 

End Sub 

Answer 2

вы могли бы использовать Application.WorksheetFunction.Subtotal(103, rng.Resize(, 1)), чтобы проверить, сколько клеток были отфильтрованы и проверить есть больше чем один (заголовки будут всегда фильтруется) в колонке

как в этом мало рефакторинга кода

Sub FilterResults() 
    Dim res As Variant 

    With ActiveSheet.Rows(1) 
     res = Application.Match("Errors", .Cells, 0) 
     If Not IsError(res) Then 
      .AutoFilter Field:=res, Criteria1:="*-SERVICE CODE*" 
      If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than header (which is in row 3) 
       MsgBox "Data" 
       With .SpecialCells(xlCellTypeVisible) 
        ' code 
       End With 
      Else 
       MsgBox "No Data" 
      End If 
     End If 
    End With 
End Sub