自定义VBA功能中EXCEL

时间:2018-10-09 12:27:29

标签: excel vba

我已经在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 个答案:

答案 0 :(得分:0)

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

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