VBA: 通过Application.OnTime定时执行程序（2）

Exploring

发布于 2024-04-15 15:33:29

780

发布于 2024-04-15 15:33:29

文章背景： 上文(参见文末的参考资料[1])提到，创建了一个自定义函数，可以获取指定路径下各个文件的最新的修改日期。另外，提供了一份VBA代码，可以遍历各个单元格，假装对单元格内的内容进行编辑，借助Application.OnTime函数定时执行该程序。

1 旧方案

实际运行过程中发现，如果自定义函数的运行时间短，则没问题；如果文件夹内的文件较多，耗时较长的话，则可能会弹出如下的对话框：

出现报错的VBA代码如下：

Sub RefreshCustomFunction()

    '存在For循环，运行容易被中止。

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    Set ws = ThisWorkbook.Worksheets("test")    '将"Sheet1"替换为你的工作表名称
    Set rng = ws.Range("C2:C9")                 '将"C2:C9"替换为你的单元格区域

    For Each cell In rng
    
        If cell.HasFormula Then
        
            cell.Select
            
            ActiveCell.Formula = cell.Formula
            
            Application.SendKeys "{ESC}"
            
        End If
        
    Next cell
    
    Application.OnTime Now + TimeValue("08:00:00"), "RefreshCustomFunction" '每隔8小时执行一次
    
End Sub

报错的可能原因是：代码中存在死循环或者长时间运行的操作，导致程序无法继续执行。

在本示例中，自定义函数需要遍历各个文件，通过比较，获取最新修改时间。所以文件夹中如果文件较多，则耗时较长，导致报错。

2 新方案

之前的策略是，遍历各个单元格，假装对单元格内的内容进行编辑，从而让自定义函数重新计算；现在采取的策略是，先在第一个单元格上填写公式，然后向下自动填充，在其他单元格内添加公式，从而让自定义函数重新计算。

VBA代码如下：

Sub RefreshCustomFunction2()

    '目前在用，每隔一段时间，执行一次

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    Set ws = ThisWorkbook.Worksheets("test")    '将"test"替换为你的工作表名称

    Range("C3").Formula = "=GetLatestModifiedDate(B3)"
    
    Range("C3:C4").FillDown
    
    Range("C8").Formula = "=GetLatestModifiedDate2(B8)"
    
    Range("C8:C9").FillDown
    
    Application.OnTime Now + TimeValue("08:00:00"), "RefreshCustomFunction" '每隔8小时执行一次
    
End Sub

目前这段代码运行下来，暂时没遇到新的问题。

参考资料：

[1] VBA: 通过Application.OnTime定时执行程序

[2] 讯飞星火大语言模型

本文参与腾讯云自媒体分享计划，分享自微信公众号。

原始发表：2024-04-05，如有侵权请联系 cloudcommunity@tencent.com 删除

vba