可以在范围内保存有效性检查的结果吗?

Range saving the result of a validity check possible?

我正在编写几个 UDF,它们都将 Range 作为输入。因为我需要检查用户输入是否有效,所以我构建了另一个 Function 来检查 IsNumericIsEmpty 等内容。每次检查完成后,如果检测到一些问题,就会显示 MsgBox。我想保留这个 MsgBox 但是因为有不同的 UDF 将用于同一个 Range 我想问一下我是否可以减少弹出窗口的数量?是否有办法“保存”另一个 Function 已经完成此 Range 的有效性检查的事实?没有办法提前知道任何函数将被调用多少次。

我的代码太长,还有其他问题,但这是基本思路:

Public Const maxn As Long = 10

Function Check(myRange As Range, p As Long, n As Long) As Boolean
    Dim i As Long, k As Long, x As Long
    Dim emptyCell As String, noNum As String, emptyRow As String 
    Dim empty(1 To maxn) As Long 

    For i = 1 To p
        For k = 1 To n
            If IsEmpty(myRange.Cells(i, k).Value) Then
                x = x + 1
                empty(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 empty(x) = 1 Then emptyCell = emptyCell & vbLf & ColNo2ColLet(myRange.Column + x - 1) & CStr(myRange.Row + i - 1)
                Next x
            End If
        Next k
    Next i
    
    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)
        Check = CVErr(xlErrValue)
        Exit Function
    End If
    Check = True
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
    ' p, n get defined and checked
    Call Check(myRange, p, n)
    ' other calculations
End Function

Function Q(myRange As Range) as Double
    ' p, n get defined and checked
    Call Check(myRange, p, n)
    ' other calculations
End Function

这就是我所做的。我声明一个变量来存储消息,然后在其中“收集”消息。最后我只在最后显示了 1 个消息框,其中包含所有消息。

Option Explicit

Dim msg As String

Sub Sample()
    Dim Ret As Variant
    msg = ""

    Ret = SomeFunctionA(1)
    Ret = SomeFunctionB(1)
    
    If msg <> "" Then MsgBox msg
End Sub

Function SomeFunctionA(x As Long) As String
    '
    '~~> Some code
    '
    If msg = "" Then msg = "Error A" Else msg = msg & vbNewLine & "Error A"
End Function

Function SomeFunctionB(x As Long) As String
    '
    '~~> Some code
    ' 
    If msg = "" Then msg = "Error B" Else msg = msg & vbNewLine & "Error B"
End Function

如果您不想一次又一次输入 If msg = "" Then msg = ... 的替代方法

Option Explicit

Dim msg As String

Sub Sample()
    Dim Ret As Variant
    msg = ""
    
    Ret = SomeFunctionA(1)
    Ret = SomeFunctionB(1)
    
    If msg <> "" Then MsgBox msg
End Sub

Function SomeFunctionA(x As Long) As String
    '
    '~~> Some code
    '
    StoreMessage "Error A"
End Function

Function SomeFunctionB(x As Long) As String
    '
    '~~> Some code
    '
    StoreMessage "Error B"
End Function

Private Sub StoreMessage(s As String)
    If msg = "" Then msg = s Else msg = msg & vbNewLine & s
End Sub