首先，先帮你修正现有代码里的小失误——你写的代码里重复了Range("Sheet6!Criteria")，正确的高级筛选语句应该是这样：

Range("Datasheet!MasterMon").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("Sheet6!Criteria"), _
    CopyToRange:=Range("Sheet6!Extract"), _
    Unique:=False

接下来要实现「条件变更自动触发筛选」，核心是利用Excel的Worksheet_Change事件——这个事件会在工作表单元格内容被修改时触发。我们可以把筛选逻辑封装成独立子程序，再在条件所在工作表的Change事件里调用它。

步骤1：封装筛选逻辑为独立子程序 #

打开VBA编辑器（按Alt+F11），右键点击VBAProject → 插入 → 模块，然后写入以下代码：

Sub RefreshAdvancedFilter()
    On Error GoTo ErrorHandler ' 错误处理，避免筛选失败导致程序崩溃
    
    ' 禁用事件，防止筛选过程中触发Change事件造成递归调用
    Application.EnableEvents = False
    
    ' 执行高级筛选
    Range("Datasheet!MasterMon").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("Sheet6!Criteria"), _
        CopyToRange:=Range("Sheet6!Extract"), _
        Unique:=False
        
ErrorHandler:
    ' 无论是否出错，都要恢复事件启用状态
    Application.EnableEvents = True
    If Err.Number <> 0 Then
        MsgBox "筛选过程出错：" & Err.Description, vbExclamation
    End If
End Sub

步骤2：添加工作表Change事件监听条件修改 #

找到条件所在的工作表（Sheet6），双击它打开代码窗口，然后写入以下事件代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 定义条件区域的范围，这里直接用你已有的命名区域"Criteria"
    Dim criteriaArea As Range
    Set criteriaArea = Me.Range("Criteria")
    
    ' 检查修改的单元格是否在条件区域内
    If Not Intersect(Target, criteriaArea) Is Nothing Then
        ' 调用刷新筛选的子程序
        RefreshAdvancedFilter
    End If
End Sub

关键细节说明 #

• 命名区域适配：如果你的条件区域已经定义了命名区域Criteria，代码里直接引用会比写固定单元格范围更灵活，后续调整条件区域大小也不用改代码。
• 事件禁用与恢复：在筛选子程序里禁用Application.EnableEvents是为了防止筛选过程中修改提取区域内容，再次触发Change事件造成无限递归。一定要在错误处理里恢复事件状态，否则后续所有工作表事件都会失效。
• 错误处理：添加错误捕获可以避免数据源或条件区域异常导致程序崩溃，同时给用户明确的出错提示。

现在，当你修改Sheet6中条件区域的内容时，高级筛选就会自动执行，刷新提取区域的结果了。

内容的提问来源于stack exchange，提问作者Sibren De Preter