Excel VBA - 检查筛选表是否返回任何结果

Question

我有一个宏，可以过滤表格（在代码中作为ListObject），然后将DataBodyRange中可见的单元格复制到单独的表格中。该代码正常工作，除非过滤操作删除了所有数据（即表格只有标题行而没有其他内容）。

有没有一种简洁的方法来检查是否有任何行是可见的？如果可能的话，我想避免使用"on error resume"语句，不过我正在努力想出其他的方法？

下面是一些伪代码以说明我的意思，如有帮助将不胜感激！

亚当

If TargetTable.DataBodyRange.VisibleRows.Count > 0 Then
    TargetTable.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=OutputPasteRange
End If

- AdamDynamic

---

当您尝试访问TargetTable.DataBodyRange.SpecialCells(xlCellTypeVisible)范围时，出现了1004错误，对吗？ - David Zemens

Answer 1

使用表格的 Range 对象，而不是 DataBodyRange。然后，检查确保 .SpecialCells(xlCellTypeVisible).Rows.Count > 1。

Sub TestEmptyTable()
Dim tbl As ListObject
Dim outputPasteRange As Range
Dim tblIsVisible As Boolean

Set tbl = ActiveSheet.ListObjects(1)
Set outputPasteRange = Range("B15")

If tbl.Range.SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
    tblIsVisible = True
Else:
    tblIsVisible = tbl.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1
End If

If tblIsVisible Then
    tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=outputPasteRange

Else:
    MsgBox tbl.Name & " has been filtered to no visible records", vbInformation

End If

End Sub

- David Zemens

---

只返回2个值：1或ListObject总行数。当您有少量过滤结果时，情况为1...这也是我的思路，但不起作用.... :) - Kazimierz Jawor

我想看一下，因为如果筛选后有6行可见，tbl.Range.SpecialCells（xlCellTypeVisible）.Rows.Count 返回1...(Excel 2010) 是否存在 bug？ - Kazimierz Jawor

谢谢，我很高兴能够理解它 :) - Kazimierz Jawor

那也是我注意到的！ - David Zemens

@KazJaw 我之前也遇到过这种情况，当时是在使用.AutoFilter时出现了这种行为 :) - David Zemens

Answer 2

只需要检查Range.Height是否不为0：

If [Table1].Height Then

此外，当 .Height 大于 0 时，不需要使用 .SpecialCells(xlCellTypeVisible)。

If TargetTable.DataBodyRange.Height Then TargetTable.DataBodyRange.Copy OutputPasteRange

- Slai

Answer 3

另一种方法是将 .SpecialCells(xlCellTypeVisible).Address 与表头行地址 tbl.HeaderRowRange.Address 进行比较。

这里是 David 代码的变体：

Sub TestEmptyTable()
    Dim tbl As ListObject
    Dim outputPasteRange As Range
    Dim tblIsVisible As Boolean

    Set tbl = ActiveSheet.ListObjects(1)
    Set outputPasteRange = Range("B15")

    tblIsVisible = tbl.Range.SpecialCells(xlCellTypeVisible).Address <> _ 
        tbl.HeaderRowRange.Address

    If tblIsVisible Then
        tbl.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy _
            Destination:=outputPasteRange
    Else
        MsgBox tbl.Name & " has been filtered to no visible records", vbInformation
    End If
End Sub

- LazerEyes01