VBA Excel筛选代码无匹配条件时返回空白表的修复需求

原代码实现双条件自动筛选功能正常，但当第二个筛选条件无匹配结果时，工作表会呈空白状态，需手动清除筛选才能恢复数据。以下是修改后的代码，实现弹出提示后自动恢复原工作表状态：

Sub filter_Available()
    Dim strInput As String
    Dim fltrdrng As Range
    Dim lUpper As Long
    Dim LstRow2 As Long
    Dim j As Integer
    Dim r As Range
    Dim wsAvailable As Worksheet
    
    ' 直接引用工作表，避免Select操作
    Set wsAvailable = ThisWorkbook.Sheets("Available")
    Set r = wsAvailable.Range(wsAvailable.Range("D1"), wsAvailable.Range("D1").End(xlDown))
    
    strInput = InputBox("Enter The Project Code")
    If strInput = "" Then Exit Sub ' 处理用户取消输入的情况
    
    ' 执行双条件筛选
    wsAvailable.Range("A:D").AutoFilter Field:=1, Criteria1:=strInput
    wsAvailable.Range("A:D").AutoFilter Field:=2, Criteria1:=ThisWorkbook.Sheets("Requirement").Range("G2").Value
    
    ' 处理可见单元格计数的错误（无匹配时SpecialCells会报错）
    On Error Resume Next
    j = WorksheetFunction.Count(r.Cells.SpecialCells(xlCellTypeVisible))
    On Error GoTo 0
    
    If j = 0 Then
        MsgBox "The ICD was not found"
        ' 清除筛选，恢复原工作表状态
        wsAvailable.AutoFilterMode = False
        Exit Sub
    Else
        ' 获取可见数据区域
        On Error Resume Next
        Set fltrdrng = Intersect(wsAvailable.UsedRange, wsAvailable.UsedRange.Offset(1)).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not fltrdrng Is Nothing Then
            lUpper = UBound(Split(fltrdrng.Address, "$"))
            LstRow2 = Split(fltrdrng.Address, "$")(lUpper)
            wsAvailable.Range("A2:D" & LstRow2).Copy Destination:=ThisWorkbook.Sheets("TempAvail").Range("A1")
        End If
        ' 可选：完成后也清除筛选，保持工作表整洁
        ' wsAvailable.AutoFilterMode = False
    End If
End Sub

关键修改点： #

• 移除Select操作：直接通过工作表对象引用单元格，避免激活工作表带来的不稳定问题。
• 添加筛选清除逻辑：在无匹配结果（j=0）时，执行wsAvailable.AutoFilterMode = False清除筛选，恢复原数据显示。
• 增加错误处理：使用On Error Resume Next处理SpecialCells(xlCellTypeVisible)在无可见单元格时的运行时错误，避免代码崩溃。
• 处理空输入：增加用户取消输入时的退出逻辑，避免无效筛选。

内容的提问来源于stack exchange，提问作者Harpreet Singh