可以在范围内保存有效性检查的结果吗?
Range saving the result of a validity check possible?
我正在编写几个 UDF,它们都将 Range
作为输入。因为我需要检查用户输入是否有效,所以我构建了另一个 Function
来检查 IsNumeric
或 IsEmpty
等内容。每次检查完成后,如果检测到一些问题,就会显示 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
我正在编写几个 UDF,它们都将 Range
作为输入。因为我需要检查用户输入是否有效,所以我构建了另一个 Function
来检查 IsNumeric
或 IsEmpty
等内容。每次检查完成后,如果检测到一些问题,就会显示 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