VBA多条件高级筛选代码运行无响应逻辑错误排查

代码无响应是多类逻辑错误、引用错误共同导致的，具体问题点如下：

• 布尔值判断逻辑混乱：VBA原生布尔常量True/False无需加引号，代码中混用"False"、"TRUE"、"True"三种字符串写法，和单元格返回的布尔类型值完全不匹配，绝大多数执行分支无法触发。
• 高级筛选条件区域引用错误：所有Hot系列条件范围的结束列全部错写为W列，例如HotM的筛选值实际在Z列，代码写为Y20:W的逆序无效范围；Cold系列条件范围仅引用了表头列，未包含实际筛选值列，高级筛选触发静默错误直接中断。
• Cold分支判断条件写反：JumpColdLI、JumpColdM两个分支的ElseIf判断条件误写为等于"False"，满足执行条件时会直接跳过。
• 无错误捕获机制：SpecialCells(xlCellTypeVisible)在无匹配筛选结果时会直接抛出运行时错误，未加错误处理时代码会直接中断退出，无任何提示。
• 数据删除逻辑存在错位风险：先取消筛选再执行删除操作，若行位置发生变动会导致引用的待删除范围出错。

Option Explicit
Sub Test_Filter()
    
    Dim Source      As Range        ' 源数据区域
    Dim Data        As Range        ' 筛选后待复制数据
    Dim criteria_HotLI As Range, criteria_HotM As Range, criteria_HotW As Range, criteria_HotC As Range
    Dim criteria_ColdLI As Range, criteria_ColdM As Range, criteria_ColdW As Range, criteria_ColdC As Range
    Dim Destination_Int As Range, Destination_Weather As Range, Destination_Mech As Range
    Dim Destination_Covid As Range, Destination_LA As Range, Destination_K9 As Range
    Dim Destination_LT As Range, Destination_Cap As Range, Destination_MF As Range, Destination_LIB As Range
    Dim Area        As Range
    ' 各分类计数变量
    Dim HotLI       As Long, HotM As Long, HotW As Long, HotC As Long
    Dim ColdLI      As Long, COldM As Long, ColdW As Long, ColdC As Long
    ' 条件非空判断变量
    Dim NonEmpty_HotLI As Boolean, NonEmpty_HotM As Boolean, NonEmpty_Hotw As Boolean, NonEmpty_HotC As Boolean
    Dim NonEmpty_ColdLI As Boolean, NonEmpty_ColdM As Boolean, NonEmpty_ColdW As Boolean, NonEmpty_ColdC As Boolean
    
    ' 读取分类计数值
    With Sheets("OPC Exception")
        HotLI = .Range("W18").Value
        HotM = .Range("Z18").Value
        HotW = .Range("AC18").Value
        HotC = .Range("AF18").Value
        ColdLI = .Range("W57").Value
        COldM = .Range("Z57").Value
        ColdW = .Range("AC57").Value
        ColdC = .Range("AF57").Value
        
        ' 读取条件非空标记
        NonEmpty_HotLI = .Range("V18").Value
        NonEmpty_HotM = .Range("Y18").Value
        NonEmpty_Hotw = .Range("AB18").Value
        NonEmpty_HotC = .Range("AE18").Value
        NonEmpty_ColdLI = .Range("V57").Value
        NonEmpty_ColdM = .Range("Y57").Value
        NonEmpty_ColdW = .Range("AB57").Value
        NonEmpty_ColdC = .Range("AE57").Value
        
        ' 定义各条件区域（修正列引用错误）
        Set criteria_HotLI = .Range("V20:W" & HotLI + 19)
        Set criteria_HotM = .Range("Y20:Z" & HotM + 19)
        Set criteria_HotW = .Range("AB20:AC" & HotW + 19)
        Set criteria_HotC = .Range("AE20:AF" & HotC + 19)
        Set criteria_ColdLI = .Range("V59:W" & ColdLI + 58)
        Set criteria_ColdM = .Range("Y59:Z" & COldM + 58)
        Set criteria_ColdW = .Range("AB59:AC" & ColdW + 58)
        Set criteria_ColdC = .Range("AE59:AF" & ColdC + 58)
    End With
    
    ' 定义源数据
    Set Source = Sheets("Working").Range("A1").CurrentRegion
    
    ' 定义各分类目标位置
    Set Destination_Int = Sheets("International").Range("A1")
    Set Destination_Weather = Sheets("Weather").Range("A1")
    Set Destination_Mech = Sheets("Mech").Range("A1")
    Set Destination_Covid = Sheets("Covid").Range("A1")
    Set Destination_LA = Sheets("Late Air").Range("A1")
    Set Destination_K9 = Sheets("K9").Range("A1")
    Set Destination_LT = Sheets("Late Trailer").Range("A1")
    Set Destination_Cap = Sheets("Capacity").Range("A1")
    Set Destination_MF = Sheets("Misflow").Range("A1")
    Set Destination_LIB = Sheets("LIB").Range("A1")
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 逐组执行筛选复制删除
    With Source
        ' HotLI 筛选
        If NonEmpty_HotLI Then
            .AdvancedFilter xlFilterInPlace, criteria_HotLI
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_LA.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' HotM 筛选
        If NonEmpty_HotM Then
            .AdvancedFilter xlFilterInPlace, criteria_HotM
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Mech.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' HotW 筛选
        If NonEmpty_Hotw Then
            .AdvancedFilter xlFilterInPlace, criteria_HotW
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Weather.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' HotC 筛选
        If NonEmpty_HotC Then
            .AdvancedFilter xlFilterInPlace, criteria_HotC
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Covid.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' ColdLI 筛选（修正判断条件错误）
        If NonEmpty_ColdLI Then
            .AdvancedFilter xlFilterInPlace, criteria_ColdLI
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_LA.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' ColdM 筛选（修正判断条件错误）
        If NonEmpty_ColdM Then
            .AdvancedFilter xlFilterInPlace, criteria_ColdM
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Mech.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' ColdW 筛选
        If NonEmpty_ColdW Then
            .AdvancedFilter xlFilterInPlace, criteria_ColdW
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Weather.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
        
        ' ColdC 筛选
        If NonEmpty_ColdC Then
            .AdvancedFilter xlFilterInPlace, criteria_ColdC
            On Error Resume Next
            Set Data = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If Not Data Is Nothing Then
                For Each Area In Data.Areas
                    Area.Copy
                    Destination_Covid.Insert xlShiftDown
                Next Area
                Data.Delete xlShiftUp
            End If
            .Parent.ShowAllData
            Set Data = Nothing
        End If
    End With
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True

End Sub

• 移除了冗余的GoTo跳转逻辑，直接用布尔值判断是否执行对应筛选分支，逻辑更清晰不会出现跳错位置的问题
• 修正了所有条件区域的列引用，确保表头列和筛选值列都被正确包含
• 增加了SpecialCells的错误捕获，无匹配筛选结果时直接跳过，不会触发运行时错误
• 调整了删除数据的顺序：筛选状态下复制完成后直接删除可见行，再取消筛选，避免行引用错位
• 增加Option Explicit强制变量声明，避免未定义变量导致的类型错误
• 增加屏幕更新开关，大幅提升多组筛选的运行速度
• 每次筛选完成后清空Data对象，避免上一次的引用残留到下一次筛选

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