Question

我正在尝试使用Goaleek或Solver在Excel中自动运行迭代计算。我之前已经做过，并且让它们根据特定单元格上的工作表更改事件自动运行，等等。但是这次，我希望它完全以VBA形式运行。此刻，输入将为“ Presscalc2”，此处显示为变量。在理想情况下，更改文本框将存储“ Presscalc2”的变量，然后四舍五入该子例程。这是我的代码：

Private Sub TextBox13_AfterUpdate()

PressCalc2 = TextBox13
Call RunSteamTemp

End Sub

Private Sub RunSteamTemp()

Dim a1 As Double
Dim a2 As Double
Dim a3 As Double
Dim a4 As Double
Dim a5 As Double
Dim a6 As Double
Dim Tc As Double
Dim Pc As Double
Dim Rc As Double
Dim T As Double

a1 = -7.859517823
a2 = 1.84408259
a3 = -11.7866479
a4 = 22.6807411
a5 = -15.9618719
a6 = 1.80122502
Tc = 647.096
Pc = 22.064
Rc = 322

tau = 1 - (T / Tc)

Goalseekval1 = Log(PressCalc2 / Pc) - (Tc / (T + 0.0000001)) * (a1 * tau + a2 * tau ^ 1.5 + a3 * tau ^ 3 + a4 * tau ^ 3.5 + a5 * tau ^ 5 + a6 * tau ^ 7.5)

On Error Resume Next
Dim bSuccess As Boolean

bSuccess = Goalseekval1.GoalSeek(0, T)
If Not bSuccess Then MsgBox "TSAT Error"

TempCalc2 = T * (9 / 5) - 459.67

Label24 = TempCalc2

End Sub

其中大多数是定义变量，我认为方程式没有任何错误。目标是通过更改“ T”将“ Goalseekval1”设置为0。现在给我的只是一个错误。我也尝试使用命令按钮而不是AfterUpdate操作来运行它，但是结果相同。任何帮助，将不胜感激。我在网上找到的示例旨在基于工作表中的单元格来运行此示例，但是在这种情况下，输入值和任何操作都将基于更新后的文本框（理想情况下）。

谢谢

克雷格

Answer 1

我确定您可以找到更有效的代码，但我提出了以下建议：

Option Explicit

Private Sub RunSteamTemp_Main()

Dim K As Double: K = 5 'Change this back to your input value PressCalc2
Dim T As Double: T = 1
Dim Target_Val As Double: Target_Val = 0
Dim Test_Val As Double
Dim Step_Val As Double: Step_Val = 0.001 'Play with this to increase accuracy
Dim Max_It As Long: Max_It = 1000000 'This limits the infinite loop case
Dim i As Long

If Abs(RunSteamTemp(T - 0.01, K) - Target_Val) > Abs(RunSteamTemp(T + 0.01, K) - Target_Val) Then Step_Val = Step_Val * -1

For i = 1 To Max_It
    Test_Val = RunSteamTemp(T, K)
    If Abs(Test_Val - Target_Val) < 0.001 Then 'where 0.001 is your error spread acceptation
        Debug.Print T, Format(Test_Val, "0.0000") 'Change this to define what you want to do with the result
        Exit Sub
    Else
        T = T + Step_Val
    End If
Next i

Debug.Print "No results close enough"

End Sub

Private Function RunSteamTemp(T, K)

Dim a1 As Double: a1 = -7.859517823
Dim a2 As Double: a2 = 1.84408259
Dim a3 As Double: a3 = -11.7866479
Dim a4 As Double: a4 = 22.6807411
Dim a5 As Double: a5 = -15.9618719
Dim a6 As Double: a6 = 1.80122502
Dim Tc As Double: Tc = 647.096
Dim Pc As Double: Pc = 22.064
Dim Rc As Double: Rc = 322 'This is not used ?

RunSteamTemp = Log(K / Pc) - (Tc / (T + 0.0000001)) * (a1 * (1 - (T / Tc)) + a2 * (1 - (T / Tc)) ^ 1.5 + a3 * (1 - (T / Tc)) ^ 3 + a4 * (1 - (T / Tc)) ^ 3.5 + a5 * (1 - (T / Tc)) ^ 5 + a6 * (1 - (T / Tc)) ^ 7.5)

End Function

这给了我可接受的结果。

Answer 2

在我先前的回答中，我试图首先确定方向，以确保不会偏离0远。但是，看来您的公式不需要这样做，所以这里是更新的更快的代码，其结果更准确： >

Option Explicit

Private Sub RunSteamTemp_Main()

Dim K As Double: K = 20 'Change this back to your input value PressCalc2
Dim T As Double: T = 0
Dim Target_Val As Double: Target_Val = 0
Dim Test_Val As Double
Dim Step_Val As Double: Step_Val = 0.1
Dim Max_It As Long: Max_It = 10000 'This limits the infinite loop case
Dim Max_i As Long: Max_i = 10 'Increase this to increase accuracy
Dim i As Long, j As Long

For i = 1 To Max_i
    For j = 1 To Max_It
        Test_Val = RunSteamTemp(T, K)
        If Test_Val < 0 Then
            T = T - Step_Val ^ i
            Exit For
        Else
            T = T + Step_Val ^ i
        End If
    Next j
Next i

T = (T - Step_Val ^ Max_i) * (9 / 5) - 459.67

'From here you can use the T as you wish : range("A1")=T , msgbox T , debug.print T ...
Debug.Print T

End Sub

Private Function RunSteamTemp(T, K)

Dim a1 As Double: a1 = -7.859517823
Dim a2 As Double: a2 = 1.84408259
Dim a3 As Double: a3 = -11.7866479
Dim a4 As Double: a4 = 22.6807411
Dim a5 As Double: a5 = -15.9618719
Dim a6 As Double: a6 = 1.80122502
Dim Tc As Double: Tc = 647.096
Dim Pc As Double: Pc = 22.064
Dim Rc As Double: Rc = 322 'This is still not used ?

RunSteamTemp = Log(K / Pc) - (Tc / (T + 0.0000001)) * (a1 * (1 - (T / Tc)) + a2 * (1 - (T / Tc)) ^ 1.5 + a3 * (1 - (T / Tc)) ^ 3 + a4 * (1 - (T / Tc)) ^ 3.5 + a5 * (1 - (T / Tc)) ^ 5 + a6 * (1 - (T / Tc)) ^ 7.5)

End Function

完全以VBA形式运行目标搜索或求解器

2 个答案: