VBA宏优化需求：无匹配数据时跳过执行后续筛选任务

原宏在遇到无匹配的筛选条件时会通过Exit Sub终止整个程序，无法执行后续筛选任务。以下是修改后的代码，实现无匹配时跳过当前筛选逻辑，继续执行后续任务：

Sub FilterAndCopyData()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim rng As Range
    Dim iSourceLastRow As Long
    Dim iTargetLastRow As Long
    Dim rng1 As Range, rng2 As Range
    Dim RRow As Long, N As Long
    
    Set wsSource = Worksheets("Sheet1")
    
    ' 第一组筛选：A列=AL1，C列=2789001，B列=ADR
    With wsSource.Range("A1")
        .AutoFilter Field:=1, Criteria1:="AL1"
        .AutoFilter Field:=3, Criteria1:="2789001"
        .AutoFilter Field:=2, Criteria1:="ADR"
        
        ' 判断是否有匹配数据（可见行>1，排除表头）
        On Error Resume Next
        Set rng = wsSource.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not rng Is Nothing And rng.Rows.Count > 1 Then
            Set wsTarget = Worksheets.Add
            wsTarget.Name = "AL1 - ADR"
            rng.Copy wsTarget.Range("A1")
        Else
            MsgBox "第一组筛选无匹配数据，跳过"
        End If
        
        ' 清除筛选
        If wsSource.AutoFilterMode Then wsSource.ShowAllData
    End With
    
    ' 第二组筛选：A列=ADR，C列=1542001，B列=AL1
    With wsSource.Range("A1")
        .AutoFilter Field:=1, Criteria1:="ADR"
        .AutoFilter Field:=3, Criteria1:="1542001"
        .AutoFilter Field:=2, Criteria1:="AL1"
        
        On Error Resume Next
        Set rng = wsSource.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not rng Is Nothing And rng.Rows.Count > 1 Then
            ' 检查目标工作表是否存在
            On Error Resume Next
            Set wsTarget = Worksheets("ADR - AL1")
            On Error GoTo 0
            
            If wsTarget Is Nothing Then
                Set wsTarget = Worksheets.Add
                wsTarget.Name = "ADR - AL1"
            End If
            
            ' 计算目标行位置
            iTargetLastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(5).Row
            rng.Copy wsTarget.Range("A" & iTargetLastRow)
            
            ' 后续处理逻辑
            wsTarget.Columns("L:M").Insert
            wsTarget.Range("L1").Value = "Reconcile"
            wsTarget.Range("M1").Value = "Yes"
            
            On Error Resume Next
            Set rng1 = wsTarget.Columns("K").SpecialCells(xlConstants, xlNumbers).Areas(1)
            Set rng2 = wsTarget.Columns("K").SpecialCells(xlConstants, xlNumbers).Areas(2)
            On Error GoTo 0
            
            If Not rng1 Is Nothing And Not rng2 Is Nothing Then
                Intersect(rng1.EntireRow, wsTarget.Columns("A:Y")).Sort Key1:=rng1, Order1:=xlAscending, Header:=xlNo
                Intersect(rng2.EntireRow, wsTarget.Columns("A:Y")).Sort Key1:=rng2, Order1:=xlAscending, Header:=xlNo
                
                rng1.Offset(, 1).Resize(, 2).Formula = Array( _
                    "=INT(ABS(K2))&"" - ""&COUNTIF(L$1:L1,INT(ABS(K2))&"" -*"")+1", _
                    "=IF(COUNTIF($L$2:$L$" & rng2.Row + rng2.Rows.Count - 1 & ",L2)=2,""x"","""")")
                rng2.Offset(, 1).Resize(, 2).Formula = Array( _
                    Replace(Replace("=INT(ABS(K#))&"" - ""&COUNTIF(L$%:L%,INT(ABS(K#))&"" -*"")+1", "#", rng2.Row), "%", rng2.Row - 1), _
                    "=IF(COUNTIF($L$2:$L$" & rng2.Row + rng2.Rows.Count - 1 & ",L" & rng2.Row & ")=2,""x"","""")")
                
                ' 颜色标记
                RRow = wsTarget.UsedRange.Rows.Count
                For N = 1 To RRow
                    If wsTarget.Cells(N, 13).Value = "x" Then
                        wsTarget.Cells(N, 11).Interior.Color = RGB(204, 255, 204)
                        wsTarget.Cells(N, 12).Interior.Color = RGB(204, 255, 204)
                    End If
                Next N
            End If
        Else
            MsgBox "第二组筛选无匹配数据，跳过"
        End If
        
        ' 清除筛选
        If wsSource.AutoFilterMode Then wsSource.ShowAllData
    End With
    
    ' 第三组筛选：A列=ESL，C列=2780001，B列=ASL
    With wsSource.Range("A1")
        .AutoFilter Field:=1, Criteria1:="ESL"
        .AutoFilter Field:=3, Criteria1:="2780001"
        .AutoFilter Field:=2, Criteria1:="ASL"
        
        On Error Resume Next
        Set rng = wsSource.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        If Not rng Is Nothing And rng.Rows.Count > 1 Then
            Set wsTarget = Worksheets.Add
            wsTarget.Name = "ESL - ASL"
            rng.Copy wsTarget.Range("A1")
        Else
            MsgBox "第三组筛选无匹配数据，跳过"
        End If
        
        ' 清除筛选
        If wsSource.AutoFilterMode Then wsSource.ShowAllData
    End With
End Sub

关键修改说明 #

• 替换终止逻辑：删除原代码中的Exit Sub，改为判断可见行数（排除表头），无匹配时仅弹出提示并清除筛选，继续执行后续筛选块。
• 增加数据有效性判断：使用SpecialCells(xlCellTypeVisible)获取可见区域，结合rng.Rows.Count > 1确保存在有效数据（表头不算）。
• 修复语法错误：移除原代码中无对应For循环的Next ws，统一变量声明位置，优化目标工作表的存在性检查。
• 统一筛选清理：每个筛选块结束后强制清除筛选，避免残留筛选条件影响下一组筛选。

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