How to write this formula in VBA? - excel

I have this formula to solve.
enter image description here
And here is my code that outputs an error in the formula.
Private Sub CommandButton6_Click()
Dim Z As String
Dim X As Double, Y As Double
Z = InputBox("Input number X!", "Inputing number X"): X = Val(Z)
Y = Sqr(2 * ((X - 2) ^ 2) * ((8 - X) - 1)^1/3
MsgBox ("Y =" + Str(Y))
End Sub

Taking into account when we get negative result under the root
Y = (2 * ((X - 2) ^ 2) * (8 - X) - 1)
If Y >= 0 Then
Y = Y ^ (1 / 3)
Else
Y = -(Abs(Y) ^ (1 / 3))
End If
This is the answer for your 2nd question in comments
Y = (2 * (X ^ 2) * (X - 6))
If Y >= 0 Then
Y = 1 + (Y ^ (1 / 3))
Else
Y = 1 - (Abs(Y) ^ (1 / 3))
End If
You can add round if you want, but haven't seen any rounding used in the image link.

Related

Hessian Matrix for VBA coding

Does Anyone have the VBA code written for the Hessian matrix to plug two functions? I have it for the jacboan matrix. I have it written using x and y slopes.
`Private Sub Hessian_Click()
Dim x, y, Step, z0, z1, xSlope, ySlope, yxSlope, xySlope
x = Val(InputBox("Input value of x to evaluate derivative at"))
y = Val(InputBox("Input value of y to evaluate derivative at"))
Step = 0.00001
'Step = Val(InputBox("Input step size"))
'Calculate Parital Central derivative of x in first function
z0 = f1xy(x - Step - Step, y)
z1 = f1xy(x + Step + Step, y)
xSlope = (z1 - z0) / (2 * Step)
'Calculate Parital Central derivative of y in first function
z0 = f1xy(x, y - Step - Step)
z1 = f1xy(x, y + Step + Step)
ySlope = (z1 - z0) / (2 * Step)
'Values for first row in Hessian Matrix
Cells(20, 1) = xSlope
Cells(20, 2) = ySlope
'Calculate Parital Central derivative of x in second function
z0 = f2xy(x - Step - Step, y)
z1 = f2xy(x + Step + Step, y)
xSlope = (z1 - z0) / (2 * Step)
'Calculate Parital Central derivative of y in second function
z0 = f2xy(x, y - Step - Step + Step)
z1 = f2xy(x, y + Step + Step - Step)
ySlope = (z1 - z0) / (2 * Step)
yxSlope = (ySlope - xSlope) / (2 * Step)
xySlope = (yxSlope - ySlope - xSlope) / (2 * Step)
'Values for second row in Hessian Matrix
Cells(21, 1) = xSlope
Cells(21, 2) = ySlope
End Sub''

VBA - Trying to get the root of a function

I got this equation to solve in VBA:
Energy = y + (0.5) ^ 2 / ( 2 * 9.81 * y ^ 2 )
but I got the Energy value and want to solve for the y value.
In R is easy: uniroot. There is something like this?
The equation is a cubic polynomial with two positive roots and one negative. We can eliminate the negative one, and consider a direct evaluation of the two positive roots with the following VBA code in a Module.
Global Const g As Double = 9.81
Global Const PI As Double = 3.14159265358979
Public Function CalcE(ByVal y As Double) As Double
CalcE = y + (0.5) ^ 2 / (2# * g * y ^ 2)
End Function
Public Function SolveForY(ByVal E As Double, Optional ByVal second As Boolean = False) As Double
' Solve "E = y + (0.5) ^ 2 / ( 2 * g * y ^ 2 )" for "y"
If Not second Then
SolveForY = E / 3# - 2# * E * Sin(Asin((16# * E ^ 3# * g - 27#) / (16# * E ^ 3# * g)) / 3#) / 3#
Else
SolveForY = E / 3# + 2# * E * Sin(Asin((16# * E ^ 3 * g - 27#) / (16# * E ^ 3 * g)) / 3# + PI / 3#) / 3#
End If
End Function
and the supporting Asin() function defined in terms of Atn().
Public Function Asin(ByVal x) As Double
If Abs(x) < 1# Then
Asin = Atn(x / Sqr(1# - x * x))
Else
Asin = 2 * Atn(1) * Sgn(x)
End If
End Function
Some example results are
? SolveForY(1#)
0.12035578724076
? SolveForY(1#, True)
0.986917853921696
And checking the solutions
? CalcE(0.12035578724076)
0.999999999999997
? CalcE(0.986917853921696)
1
Consider using algebra:
Energy = y + (0.5)^2 / ( 2 * 9.81 * y^2 )
Energy = y + .25 / ( 19.62 * y^2 )
Energy * ( 19.62 * y^2 ) = y * ( 19.62 * y^2 ) + .25
Energy * 19.62 * y^2 = 19.62 * y^3 + .25
0 = 19.62 * y^3 - Energy * 19.62 * y^2 + .25
and apply standard techniques:
Previous Post
Here's a translation of John Alexiou's answer from VBA to Excel formulas. If energy in in cell B2 then the three solutions are given by:
=B2/3-2*B2*SIN((ASIN((16*B2^3*9.81-27)/(16*B2^3*9.81))+0*PI())/3)/3
=B2/3-2*B2*SIN((ASIN((16*B2^3*9.81-27)/(16*B2^3*9.81))+4*PI())/3)/3
=B2/3-2*B2*SIN((ASIN((16*B2^3*9.81-27)/(16*B2^3*9.81))+2*PI())/3)/3
The third equation gives negative y.

I can't print the values to "arka" at excel VBA

Dim i As Double
Dim x As Double
Dim y As Integer
Dim araba As Integer
Dim n As Integer
Dim bobin As Integer
Dim iplik As Integer
n = Sheets("kaynak").Cells(21, 1)
bobin = ((630 - n) / 2)
Dim j As Integer
For j = 1 To 10
iplik = Sheets("kaynak").Cells(j, 1)
For i = bobin To bobin + iplik
If i <= 315 Then
x = 7 - Int(i / 45) 'kaçıncı satır'
y = 45 - (i Mod 45)
Sheets("front").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
Else
If i = 630 Then
x = 7
Else
x = Int(i / 45) - 6
End If
y = 46 - (i Mod 45)
Sheets("arka").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
End If
Next i
bobin = bobin + iplik
Next j
my problem is at the title actually i want to print values to "arka" but it does just to "front" it works truely for front but doesn't go for further and i stopts at 315 ,i got error 1004 application defined or object defined error
When i = 315 (the last pass when i <= 315) then
x = 7 - Int(i / 45) 'kaçıncı satır'
gives x the value 0, since 315/45 = 7 exactly.
This causes the line
Sheets("front").Cells(x, y) = Sheets("kaynak").Cells(j, 2)
to error-out. You never progress beyond that line in that pass through the loop. Thus your code never even attempts to write to sheet "arka".
Perhaps replacing the line
x = 7 - Int(i / 45)
with
x = Application.Max(1,7 - Int(i / 45))
will fix the error.

An error with some simple lists and if statements in python

I wrote a code in python 3 but I get an error on the following line of code:
if x > blacks[i*2] and y < blacks[(i*2)+1] and ((x - blacks[i*2]) / (blacks[(i*2)+1]-y) <= 1 :
I don't think the problem is related with the rest of the code because I get the error even when I try using this 'if statement' in a very simple code:
blacks = [0,0,0,0,0]
i = 1
x = 0
y = 0
if x > blacks[i*2] and y < blacks[(i*2)+1] and ((x - blacks[i*2]) / (blacks[(i*2)+1]-y) <= 1 :
blacks[i * 2] = blacks[i * 2]+4
blacks[(i * 2) + 1] = blacks[(i * 2)+1] - 2
Am I missing something really obvious?
The problem is right here
(x - blacks[i*2]) / (blacks[(i*2)+1]-y)
Both of those values on either side of the / evaluate to 0, therefore you're dividing 0 by 0.
You're missing the right parentheses at the end of the expression in the if statement, or rather you have an extra left parentheses before (x - blacks[i*2]), which should be corrected as follows:
blacks = [0,0,0,0,0]
i = 1
x = 0
y = 0
if x > blacks[i*2] and y < blacks[(i*2)+1] and (x - blacks[i*2]) / (blacks[(i*2)+1]-y) <= 1:
blacks[i * 2] = blacks[i * 2]+4
blacks[(i * 2) + 1] = blacks[(i * 2)+1] - 2

Can someone tell me why the given code below gets into an infinite loop?

Do While x2 <> Abs(x1) - Abs(f1 / f2)
f1 = (4 * x1) - (16 / (x1 ^ 2))
f2 = 4 + (32 / (x1 ^ 3))
x2 = (x1) - (f1 / f2)
' Output to Screen
Cells(counter, 1) = x1
Cells(counter, 3) = f1
Cells(counter, 4) = f2
counter = counter + 1
Loop
The above loop has become infinite. How do I get out of it? What is the error in there?
A better structure may be to have your loop condition be the difference against the target. Also, I placed some error handling in to avoid troublesome conditions.
Do While difference > 0.001
f1 = (4 * x1) - (16 / (x1 ^ 2))
f2 = 4 + (32 / (x1 ^ 3))
x2 = (x1) - (f1 / f2)
' Output to Screen
Cells(counter, 1) = x1
Cells(counter, 3) = f1
Cells(counter, 4) = f2
counter = counter + 1
'Avoid runaway condition
If counter > 1000 Then
MsgBox "WARNING!" & Chr(10) & "1000 cycles exceeded"
Exit Do
End If
'Divison by zero
If f2 = 0 Then
MsgBox "ERROR!" & Chr(10) & "Divion by zero"
Exit Do
End If
'calculate difference from target
difference = Abs(x2 - (Abs(x1) - Abs(f1 / f2)))
Loop
You could also use the round function to do something like this...
Do While round(x2 - (Abs(x1) - Abs(f1 / f2)),3) <> 0
or this...
Do While round(x2,3) <> round(Abs(x1) - Abs(f1 / f2),3)
Which is the closest to your original code

Resources