Excel VBA表格筛选：如何编写If语句规避空数据复制错误

问题说明 #

需要对ListObject对象的表格进行筛选，将筛选出的可见数据复制到指定区域。当前代码在有可见数据时复制正常，但无可见数据时会错误复制整列，希望无数据时直接进入下一步筛选流程。

原尝试代码 #

Dim Table as ListObject
Set Table = Thisworkbook.ListObjects("Table")

Table.AutoFilter.ShowAllData
Table.Range.AutoFilter Field:=20, Criteria1:="Lunes", Operator:=xlAnd
Table.Range.AutoFilter Field:=16, Criteria1:=Range("Tema1Lun").Value, Operator:=xlAnd
Table.Range.AutoFilter Field:=17, Criteria1:="=*TV*", Operator:=xlAnd
        If Table.DataBodyRange = 0 Then
                GoTo Filter2
        ElseIf Range("Table[Column1]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            With Range("Table[Column2]:Table[Column3]").Copy
            End With
                Range("SpecificRange").PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
       End If
                
Filter2:
Table.AutoFilter.ShowAllData
Table.Range.AutoFilter Field:=20, Criteria1:="Lunes", Operator:=xlAnd
Table.Range.AutoFilter Field:=16, Criteria1:=Range("Tema1Lun").Value, Operator:=xlAnd
Table.Range.AutoFilter Field:=17, Criteria1:="0", Operator:=xlAnd

修正后的代码 #

Dim Table As ListObject
Dim visibleRows As Range

Set Table = ThisWorkbook.ListObjects("Table")

' 第一次筛选
Table.AutoFilter.ShowAllData
Table.Range.AutoFilter Field:=20, Criteria1:="Lunes"
Table.Range.AutoFilter Field:=16, Criteria1:=Range("Tema1Lun").Value
Table.Range.AutoFilter Field:=17, Criteria1:="=*TV*"

' 检查是否有可见数据行
On Error Resume Next
Set visibleRows = Table.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Not visibleRows Is Nothing Then
    ' 复制指定列的可见数据到目标区域
    Table.ListColumns("Column2").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
    Range("SpecificRange").PasteSpecial Paste:=xlPasteValues
    Table.ListColumns("Column3").DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
    Range("SpecificRange").Offset(0, 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If

' 进入第二次筛选流程
Filter2:
Table.AutoFilter.ShowAllData
Table.Range.AutoFilter Field:=20, Criteria1:="Lunes"
Table.Range.AutoFilter Field:=16, Criteria1:=Range("Tema1Lun").Value
Table.Range.AutoFilter Field:=17, Criteria1:="0"

关键修正点 #

• 可靠判断可见数据：通过错误捕获机制处理SpecialCells的异常，当无可见数据行时，visibleRows会被设为Nothing，以此作为判断依据，替代原代码中错误的Table.DataBodyRange = 0判断。
• 精准定位数据区域：使用ListObject的ListColumns属性直接获取目标列的数据区域（DataBodyRange），而非引用整列，彻底避免无数据时误复制整列的问题。
• 简化冗余代码：单个筛选条件下无需指定Operator:=xlAnd，删除该参数让代码更简洁。

内容的提问来源于stack exchange，提问作者Javier Puig Rovira