Excel VBA中能否存储Range有效性校验结果以减少重复提示弹窗？

核心思路是通过缓存已校验Range的校验状态，避免对同一个区域重复执行校验逻辑和弹出提示，具体实现如下： #

1. 实现逻辑说明 #

• 用Scripting.Dictionary作为缓存容器，以「工作表名+区域地址」作为唯一键，存储对应Range的校验结果，已校验过的区域直接读取缓存返回，不重复执行校验和弹窗。
• 可选添加缓存失效机制：当工作表单元格内容被修改时清空缓存，避免区域内容更新后缓存的校验结果过时。

2. 完整修改后代码 #

Public Const maxn As Long = 10
' 声明全局缓存字典，用于存储已校验的Range状态
Private cache As Object

Function Check(myRange As Range, p As Long, n As Long) As Variant
    ' 初始化缓存字典，晚绑定无需手动添加引用
    If cache Is Nothing Then
        Set cache = CreateObject("Scripting.Dictionary")
    End If
    
    ' 生成当前Range的唯一键，避免不同工作表同地址的Range冲突
    Dim rangeKey As String
    rangeKey = myRange.Worksheet.Name & "!" & myRange.Address
    
    ' 已存在缓存直接返回结果，不重复校验弹窗
    If cache.Exists(rangeKey) Then
        Check = cache(rangeKey)
        Exit Function
    End If
    
    ' 原有的校验逻辑保持不变
    Dim i As Long, k As Long, x As Long
    Dim emptyCell As String, noNum As String, emptyRow As String
    Dim emptyArr(1 To maxn) As Long ' 注意原变量名empty和VBA内置函数重名，修改为emptyArr避免冲突

    For i = 1 To p
        x = 0 ' 注意原代码遗漏了x的逐行重置，会导致空行判断错误，这里补充修复
        Erase emptyArr ' 逐行清空空单元格标记数组
        For k = 1 To n
            If IsEmpty(myRange.Cells(i, k).Value) Then
                x = x + 1
                emptyArr(k) = 1
                If x = n Then
                    emptyRow = emptyRow & vbLf & CStr(myRange.Row + i - 1)
                End If
            ElseIf Not IsNumeric(myRange.Cells(i, k).Value) Then
                noNum = noNum & vbLf & ColNo2ColLet(myRange.Column + k - 1) & CStr(myRange.Row + i - 1)
            End If
            If k = n And x > 0 And x <> n Then
                For x = 1 To n
                    If emptyArr(x) = 1 Then emptyCell = emptyCell & vbLf & ColNo2ColLet(myRange.Column + x - 1) & CStr(myRange.Row + i - 1)
                Next x
            End If
        Next k
    Next i
    
    Dim checkResult As Variant
    checkResult = True
    
    If emptyRow <> "" Then
        emptyRow = "Following rows are empty and will not be considered:" & emptyRow
        MsgBox emptyRow
    End If
    If emptyCell <> "" Then
        emptyCell = "Following cells are empty and will not be considered:" & emptyCell
        MsgBox emptyCell
    End If
    If noNum <> "" Then
        noNum = "Following cells contain nonnumeric values:" & noNum
        MsgBox noNum
        checkResult = CVErr(xlErrValue)
    End If
    
    ' 将校验结果存入缓存
    cache.Add rangeKey, checkResult
    Check = checkResult
End Function

Function ColNo2ColLet(x As Long) As String
'returns the Letters corresponding to the Column number provided by myRange.Column
End Function

Function sr(myRange As Range) As Double
    Dim p As Long, n As Long
    ' p, n 原有定义逻辑保持不变
    Dim checkRes As Variant
    checkRes = Check(myRange, p, n)
    ' 校验失败返回错误值
    If IsError(checkRes) Then
        sr = checkRes
        Exit Function
    End If
    ' 其他原有计算逻辑保持不变
End Function

Function Q(myRange As Range) As Double
    Dim p As Long, n As Long
    ' p, n 原有定义逻辑保持不变
    Dim checkRes As Variant
    checkRes = Check(myRange, p, n)
    If IsError(checkRes) Then
        Q = checkRes
        Exit Function
    End If
    ' 其他原有计算逻辑保持不变
End Function

3. 缓存失效配置（可选） #

如果需要在用户修改单元格内容后自动更新校验结果，可以在对应工作表的代码模块中添加以下事件代码，修改单元格时清空缓存，下次调用UDF时会重新校验：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 清空校验缓存，触发下次调用时重新校验
    If Not cache Is Nothing Then
        cache.RemoveAll
    End If
End Sub

额外优化说明 #

• 修复了原代码中x变量没有逐行重置、empty变量名和VBA内置函数重名的问题，避免校验逻辑出错。
• 调整Check函数返回值为Variant类型，兼容错误值返回，避免原代码中Boolean类型返回错误值导致的类型不匹配报错。

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