gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-04 20:53:45 25 4
gpt4 key购买 nike

我在 Excel 工作簿中定义了一个函数,该函数计算物理属性,输入温度和压力。
它对专用电子表格上的 T/P 矩阵中的离散数据进行插值。可以根据需要修改矩阵。
如果给定的输入数据之一落在数据矩阵范围之外,则强制函数使用边界进行计算。例如:如果矩阵中的离散温度数据是从 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”之间的平均值。

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

Sheet "Z"

最佳答案

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

1)我修改了函数以给出一个变体(1,2)数组作为结果。第一个数据是实际的函数输出,而第二个数据是一个 bool 值,如果计算已被强制(不准确),则为“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

关于excel - EXCEL 的自定义 VBA 函数中的用户定义警告,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/52721072/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com