Фильтр VBA возвращает 0 строк, как определить

Удалить пустые строки в указанном столбце таблицы Excel (ListObject)

Проблемы

• colFornecedor.Range — это один столбец. Вы не можете фильтровать один столбец по любому другому (colFornecedor.Index) полю, кроме 1.

• Если вы фильтруете таким образом (с помощью 1), вы не сможете так легко ссылаться на все отфильтрованные строки таблицы (вам нужен медленный Intersect).

• При работе с таблицей Excel, IMO, неправильно (по крайней мере, нет необходимости) выходить за пределы ее строк и столбцов, например. используя rngFiltro.EntireRow, т. е. вы хотите сохранить все, что находится за пределами таблицы, нетронутым.

• Либо пас Worksheet, либо ListObject. Обычно на один можно ссылаться, используя другой, например:

  Dim ws As Worksheet: Set ws = lo.Range.Worksheet
  Dim lo As ListObject: Set lo = ws.ListObjects(1)
  

  Вы никоим образом не используете переменную ws, поэтому ваш оператор With просто избыточен при передаче рабочего листа.

Улучшение

Sub DeleteBlankSupplierRows( _
        ByVal lo As ListObject, _
        Optional ByVal DisplayMessages As Boolean = False)
    Const PROC_TITLE As String = "Delete Blank Supplier Rows"
    
    ' Define constants.
    Const LIST_COLUMN_NAME As String = "Fornecedor"
    Const COLUMN_CRITERION As String = ""
    
    ' Declare a variable to hold the filtered rows (range object).
    Dim frg As Range
    
    ' Filter the table.
    With lo
        ' Clear table filters.
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
        ' Filter.
        .Range.AutoFilter _
            Field:=.ListColumns(LIST_COLUMN_NAME).Index, _
            Criteria1:=COLUMN_CRITERION
        ' Reference the filtered rows.
        On Error Resume Next
            Set frg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        ' Clear table filters.
        .AutoFilter.ShowAllData
    End With
        
    ' Check if no filtered rows.
    If frg Is Nothing Then
        If DisplayMessages Then
            MsgBox "No blank Supplier rows found!", vbExclamation, PROC_TITLE
        End If
        Exit Sub
    End If
        
    ' Delete filtered rows.
    frg.Delete Shift:=xlShiftUp
        
    ' Inform.
    If DisplayMessages Then
        MsgBox "Blank Supplier rows deleted.", vbInformation, PROC_TITLE
    End If
        
End Sub

Более динамичный

Процедура вызова (пример)

Sub DeleteBlankSupplierRows()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    Dim lo As ListObject: Set lo = ws.ListObjects("Table1")
    
    DeleteRows lo, "Fornecedor", "", True
    
End Sub

Вызываемая процедура (метод)

Sub DeleteRows( _
        ByVal lo As ListObject, _
        ByVal ListColumnName As String, _
        ByVal Criterion As String, _
        Optional ByVal DisplayMessages As Boolean = False)
    Const PROC_TITLE As String = "Delete Rows"
    
    ' Declare a variable to hold the filtered rows (range object).
    Dim frg As Range
    
    ' Filter the table.
    With lo
        ' Clear table filters.
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
        ' Filter.
        .Range.AutoFilter _
            Field:=.ListColumns(ListColumnName).Index, _
            Criteria1:=Criterion
        ' Reference the filtered rows.
        On Error Resume Next
            Set frg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        ' Clear table filters.
        .AutoFilter.ShowAllData
    End With
        
    ' Check if no filtered rows.
    If frg Is Nothing Then
        If DisplayMessages Then
            MsgBox "No cells equal to """ & Criterion & """ in column """ _
                & ListColumnName & """ of table """ & lo.Name & """ found!", _
                vbExclamation, PROC_TITLE
        End If
        Exit Sub
    End If
        
    ' Delete filtered rows.
    frg.Delete Shift:=xlShiftUp
        
    ' Inform.
    If DisplayMessages Then
        MsgBox "Deleted rows where cells were equal to """ & Criterion _
            & """ in column """ & ListColumnName & """ of table """ _
            & lo.Name & """.", vbInformation, PROC_TITLE
    End If
        
End Sub