EXCEL 的自定义 VBA 函数中的用户定义警告

Posted 2023-04-13

【中文标题】EXCEL 的自定义 VBA 函数中的用户定义警告

【英文标题】：User defined warning in custom VBA Function for EXCEL

【发布时间】：2018-10-09 12:27:29

【问题描述】：

我在 Excel 工作簿中定义了一个函数，该函数以 温度 和 压力 作为输入来计算物理属性。 它在专用电子表格上对来自 T/P 矩阵的离散数据进行插值。矩阵可以根据需要进行修改。 如果给定的输入数据之一落在数据矩阵范围之外，则强制函数使用边界进行计算。 例如：如果矩阵中的离散Temperatures数据是从40°C到90°C，在低于40°C的温度的情况下，给函数作为输入它将继续使用 40°C 进行计算。

我想做的是在包含函数调用的单元格内发出警告。为了警告用户结果是外推的，可能不准确。当数字格式设置为文本或单元格内的公式与同一列或同一行的单元格中的公式不同时，类似于 excel 在单元格内向您发出的警告。

有可能吗？

为了清楚起见，我添加我写的代码：

Function Z(T As Double, P As Double)
Dim i As Integer, j As Integer, r As Integer, c As Integer
Dim T1 As Double, T2 As Double, P1 As Double, P2 As Double, Z1 As Double, Z2    As Double
Dim ckp As Boolean, ckt As Boolean
Dim wks As Worksheet
Set wks = ThisWorkbook.Sheets("Z")
i = 2
j = 2
ckp = False
cht = False
'check if T < T min; if yes, set T = T min
    If T < wks.Cells(1, 2) Then
    i = 3
    T = wks.Cells(1, 2).Value
    ckt = True
End If
'check if P < P min; if yes, set P = P min
If P < wks.Cells(2, 1) Then
    j = 3
    P = wks.Cells(2, 1).Value
    ckp = True
End If
'if temperature is not below the minimum, find the column containing the T_
   immediately above the given one.
If ckt = False Then
    Do
        i = i + 1
        'Check if T is > T max; if a blank cell is found during seeking, T_
 is set at maximum.
        If wks.Cells(1, i) = "" Then
            T = wks.Cells(1, i - 1)
            i = i - 1
            ckt = True
        End If
    Loop While wks.Cells(1, i) < T And ckt = False
End If
'if pressure is not below the minimum, find the row containing the P_
 immediately above the given one.
If ckp = False Then
    Do
        j = j + 1
        'Check if P is > P max; if a blank cell is found during seeking, P_
is set at maximum.
        If wks.Cells(j, 1) = "" Then
            P = wks.Cells(j - 1, 1)
            j = j - 1
            ckp = True
        End If
    Loop While wks.Cells(j, 1) < P And ckp = False
End If
'Calculate the function by sequentially using Line Passing Through Two_
Points (RDP)user defined function.
'T1 is the temperature immediately below the given one and T2 is the_
temperature immediately above the given one
'T will be between T1 and T2
'P1 is the pressure immediately below the given one and P2 is the pressure_
immediately above the given one
'P will be between P1 and P2
T1 = wks.Cells(1, i - 1)
T2 = wks.Cells(1, i)
P1 = wks.Cells(j - 1, 1)
P2 = wks.Cells(j, 1)
'Calculate function at T1 and P
Z1 = RDP(P1, P2, wks.Cells(j - 1, i - 1), wks.Cells(j, i - 1), P)
'Calculate function at T2 and P
Z2 = RDP(P1, P2, wks.Cells(j - 1, i), wks.Cells(j, i), P)
'Calculate function at T and P
Z = RDP(T1, T2, Z1, Z2, T)
End Function

我还添加了“Z”电子表格的快照。数据通过过程模拟软件计算。通过这种方式，我可以在 T 和 P 在不同范围和步长之间变化的计算中使用相同的电子表格，因为该函数仍然能够运行。我所需要的只是告诉我的函数：“我给了你一个结果，但考虑到你给了我一个超出范围的参数，所以要注意”，而不停止处理数据（它在数百个单元格中使用，以及其他类似的计算其他参数的函数）

在“Z”电子表格快照中，T 在第一行，P 在第一列。在“J2”单元格中，您可以看到输入温度为 100°C 和压力为 42.5 bar（平均在 40 到 45 之间）的结果。结果是 Z“90°C 和 40 bar”与 Z“90°C 和 45 bar”之间的平均值。

我希望现在这个问题更清楚了。

【问题讨论】：

你应该改变你的函数来检查温度是低于 40 还是高于 90 并让它返回一个文本。

我认为您说的是在 Range.Error 属性上引发错误 - 您不能在那里引发自定义错误。如果该函数是单元格内自定义函数，则您也不能将值返回到不同的单元格 - 但您可以显示一个消息框。我们可以看看你已有的代码吗？

非常感谢您的及时回复。不幸的是，使用该函数的单元格数量（数百个）使得使用 msgbox 或文本输出不切实际。我希望这个问题更清楚，现在我已经更新了。

【参考方案1】：

我找到了已发布问题的解决方案并分享它，希望它有用。即使它不涉及警告消息，也会警告用户某些东西不是最佳的，并且给定的结果可能不准确。我是这样进行的：

1) 我修改了函数以给出一个变体 (1,2) 数组作为结果。第一个数据是实际的函数输出，而第二个数据是一个布尔值，如果计算已被强制（不准确），则为“TRUE”，否则为“FALSE”。

2) 我要求 excel 评估“INDEX(Z(cellA,cellB),2)”，以有条件地格式化使用该函数的单元格，使用单元格内函数的相同参数。

这样，每次函数被强制输出时，单元格结果都会以不同的方式格式化（例如，使用粗体和红色字符）。

下面是修改后的函数：

Function Z(T As Double, P As Double)
Dim i As Integer, j As Integer, r As Integer, c As Integer
Dim T1 As Double, T2 As Double, P1 As Double, P2 As Double, Z1 As Double, _
Z2 As Double
Dim ckp As Boolean, ckt As Boolean
Dim wks As Worksheet
Dim returnval(2)
Set wks = ThisWorkbook.Sheets("Z")
i = 2
j = 2
ckp = False
ckt = False
'check if T < T min; if yes, set T = T min
If T < wks.Cells(1, 2) Then
    i = 3
    T = wks.Cells(1, 2).Value
    ckt = True
End If
'check if P < P min; if yes, set P = P min
If P < wks.Cells(2, 1) Then
    j = 3
    P = wks.Cells(2, 1).Value
    ckp = True
End If
'if temperature is not below the minimum, find the column containing the T_
 immediately above the given one.
If ckt = False Then
    Do
        i = i + 1
        'Check if T is > T max; if a blank cell is found during seeking, T _
is set at maximum.
        If wks.Cells(1, i) = "" Then
            T = wks.Cells(1, i - 1)
            i = i - 1
            ckt = True
        End If
    Loop While wks.Cells(1, i) < T And ckt = False
End If
'if pressure is not below the minimum, find the row containing the P_
 immediately above the given one.
If ckp = False Then
    Do
        j = j + 1
        'Check if P is > P max; if a blank cell is found during seeking, P_
 is set at maximum.
        If wks.Cells(j, 1) = "" Then
            P = wks.Cells(j - 1, 1)
            j = j - 1
            ckp = True
        End If
    Loop While wks.Cells(j, 1) < P And ckp = False
End If
'Calculate the function by sequentially using Line Passing Through Two_
 Points (RDP)user defined function.
'T1 is the temperature immediately below the given one and T2 is the_
 temperature immediately above the given one
'T will be between T1 and T2
'P1 is the pressure immediately below the given one and P2 is the_
 pressure immediately above the given one
'P will be between P1 and P2
T1 = wks.Cells(1, i - 1)
T2 = wks.Cells(1, i)
P1 = wks.Cells(j - 1, 1)
P2 = wks.Cells(j, 1)
'Calculate function at T1 and P
Z1 = RDP(P1, P2, wks.Cells(j - 1, i - 1), wks.Cells(j, i - 1), P)
'Calculate function at T2 and P
Z2 = RDP(P1, P2, wks.Cells(j - 1, i), wks.Cells(j, i), P)
'Calculate function at T and P
returnval(0) = RDP(T1, T2, Z1, Z2, T)
If ckt = True Or ckp = True Then
    returnval(1) = True
Else
    returnval(1) = False
End If
Z = returnval
End Function