如何让每5秒运行的Excel筛选宏仅作用于当前工作簿？

我有一个每5秒运行一次的筛选宏，当打开或切换到其他工作簿时，宏会在标注的代码行停止运行。需要修改代码让这个筛选宏仅作用于包含它的工作簿，不受当前激活工作簿的影响。

原VBA代码如下：

Sub ONE()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Application.ScreenUpdating = False
    Dim rngDatabase As Range
    Dim rngCriteria As Range
    ' 定义数据区域和条件区域
    Set rngDatabase = wb.Worksheets("myLIST").Range("A3:Z5000") '  此处停止运行
    Set rngCriteria = wb.Worksheets("ONE").Range("A3:Z4")
    ' 将筛选后的数据复制到指定位置
    rngDatabase.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=wb.Worksheets("ONE").Range("A5:Z5010"), Unique:=True
    ' 对筛选后的数据排序
     With wb.Application.Worksheets("ONE")
         wb.Worksheets("ONE").Range("A6:Z5000").Sort Key1:=wb.Worksheets("ONE").Range("U6"), Order1:=xlAscending
     End With       
End Sub

问题分析 #

你已经用ThisWorkbook指定了宏所在的工作簿，但报错的核心原因是定时触发机制未绑定工作簿状态：当切换到其他工作簿时，定时任务仍在执行，若宏所在工作簿处于非激活状态，或定时调用逻辑未做限制，就会触发工作表访问错误。

解决方案 #

1. 绑定定时任务到工作簿激活状态 #

如果你的定时是通过Application.OnTime实现的，需要在工作簿激活时启动任务，失活时取消任务。在ThisWorkbook模块中添加以下代码：

Private nextRunTime As Date

Private Sub Workbook_Activate()
    ' 激活工作簿时，启动5秒一次的定时任务
    nextRunTime = Now + TimeValue("00:00:05")
    Application.OnTime nextRunTime, "ONE"
End Sub

Private Sub Workbook_Deactivate()
    ' 切换到其他工作簿时，取消定时任务
    On Error Resume Next ' 避免任务已执行导致报错
    Application.OnTime nextRunTime, "ONE", , False
    On Error GoTo 0
End Sub

2. 优化宏内的错误防护逻辑 #

在宏中添加工作表存在性检查，避免因工作表被删除/重命名导致崩溃，同时简化对象引用：

Sub ONE()
    Dim wb As Workbook: Set wb = ThisWorkbook
    Application.ScreenUpdating = False
    
    ' 检查必要工作表是否存在
    On Error Resume Next
    Dim wsList As Worksheet: Set wsList = wb.Worksheets("myLIST")
    Dim wsOne As Worksheet: Set wsOne = wb.Worksheets("ONE")
    On Error GoTo 0
    
    ' 若工作表不存在，直接退出
    If wsList Is Nothing Or wsOne Is Nothing Then
        Application.ScreenUpdating = True
        Exit Sub
    End If
    
    Dim rngDatabase As Range
    Dim rngCriteria As Range
    
    ' 定义数据和条件区域
    Set rngDatabase = wsList.Range("A3:Z5000")
    Set rngCriteria = wsOne.Range("A3:Z4")
    
    ' 执行高级筛选
    rngDatabase.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=rngCriteria, _
        CopyToRange:=wsOne.Range("A5:Z5010"), _
        Unique:=True
    
    ' 排序数据
    With wsOne.Range("A6:Z5000")
        .Sort Key1:=wsOne.Range("U6"), Order1:=xlAscending, Header:=xlNo
    End With
    
    Application.ScreenUpdating = True
    
    ' 重置下一次定时任务
    nextRunTime = Now + TimeValue("00:00:05")
    Application.OnTime nextRunTime, "ONE"
End Sub

3. 关键说明 #

• ThisWorkbook始终指向包含宏代码的工作簿，不受当前激活工作簿变化影响，你原代码已使用该对象，配合定时任务的激活/失活控制即可彻底解决问题。
• 添加工作表存在性检查，避免因工作表状态异常导致宏崩溃。
• 工作簿失活时取消定时任务，从根源上避免切换工作簿后宏继续执行引发的错误。

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