I have a problem of conversion. When I write txta1 = txta1.Text, it shows "text is not a member of double." I'm not sure why, can someone explain this to me?
Private Sub btnCalculate_Click(sender As Object, e As EventArgs) Handles btnCalculate.Click
Dim treatments As String
Dim ssb, ssw, msb, msw, sigmaA, sigmaB, sigmaC, sigmaabc, squaresigmaA, squaresigmaB, squaresigmaC, squaresigmaabc, f As Double
Dim txta1, txta2, txta3, txta4, txta5, txtb1, txtb2, txtb3, txtb4, txtb5, txtc1, txtc2, txtc3, txtc4, txtc5 As Double
'Data Input
txta1 = txta1.Text
treatments = lblTreatments.Text
'Calaculation
sigmaA = txta1 + txta2 + txta3 + txta4 + txta5
sigmaB = txtb1 + txtb2 + txtb3 + txtb4 + txtb5
sigmaC = txtc1 + txtc2 + txtc3 + txtc4 + txtc5
sigmaabc = sigmaA + sigmaB + sigmaC
squaresigmaA = txta1 ^ 2 + txtb2 ^ 2 + txtb3 ^ 2 + txtb4 ^ 2 + txtb5 ^ 2
squaresigmaB = txtb1 ^ 2 + txtb2 ^ 2 + txtb3 ^ 2 + txtb4 ^ 2 + txtb5 ^ 2
squaresigmaC = txtc1 ^ 2 + txtc2 ^ 2 + txtc3 ^ 2 + txtc4 ^ 2 + txtc5 ^ 2
squaresigmaabc = squaresigmaA + squaresigmaB + squaresigmaC
ssb = ((sigmaA) ^ 2 / 5 + (sigmab) ^ 2 / 5 + (sigmac) ^ 2 / 5) - (sigmaabc) ^ 2 / 15
ssw = squaresigmaabc - ((sigmaA) ^ 2 / 5 + (sigmab) ^ 2 / 5 + (sigmac) ^ 2 / 5)
msb = ssb / (3 - 1)
msw = ssw / (15 - 1)
f = msb / msw
'Data output
lblSSB.Text = ssw
lblSSW.Text = ssw
lblMSB.Text = msb
lblMSW.Text = msw
lblF.Text = f
End Sub
As the compiler is trying to tell you, you declared txta1 as a Double, which has no Text property.
You should choose different names for your controls and your local variables.
You've declared txta1 as a Double in line 4. I assume you also have a TextBox called txta1 on your form. Use a different name like txta1Value for the Double, so it doesn't clash with the name of the TextBox. Then you can say
txta1Value = Double.Parse(txta1.Text)
(This will blow up if someone types something other than a valid Double; how you want to deal with that is up to you.)
Related
I am having a problem, when I try to enter Japanese characters into the VB console they show up as question marks with no data attached to them. I am writing a program to help me conjugate words and I need to be able to input Japanese characters to do so.
Is there a setting I can change to allow the input and output of these characters?
I have found the the solution!
Add the following code to the top of your code:
Console.InputEncoding = System.Text.Encoding.Unicode
Console.OutputEncoding = System.Text.Encoding.Unicode
This will allow the input of foreign characters but it won't allow you to see the actual characters, (the characters will just have value)
Run the code
At the top left of the console, there is a an icon, click it, and then click properties
Go to the font tab and change the font. So far, the ones that work for me are any that begin with "MS", but "SimSun-ExtB" works too.
Click "Ok" and you're done!
This document has a reference for several unicode ranges.
You can try my method as follows. Please pay attention to RichTextBox1.Text &= (ChrW(i)) which is the most important step.
Public Class Form1
Dim First_Unicode, Last_unicode As Integer
'Hexadecimal to Decimal
Public Function H2D(ByVal Hex As String) As Long
Dim i As Long
Dim b As Long
Hex = UCase(Hex)
For i = 1 To Len(Hex)
Select Case Mid(Hex, Len(Hex) - i + 1, 1)
Case "0" : b = b + 16 ^ (i - 1) * 0
Case "1" : b = b + 16 ^ (i - 1) * 1
Case "2" : b = b + 16 ^ (i - 1) * 2
Case "3" : b = b + 16 ^ (i - 1) * 3
Case "4" : b = b + 16 ^ (i - 1) * 4
Case "5" : b = b + 16 ^ (i - 1) * 5
Case "6" : b = b + 16 ^ (i - 1) * 6
Case "7" : b = b + 16 ^ (i - 1) * 7
Case "8" : b = b + 16 ^ (i - 1) * 8
Case "9" : b = b + 16 ^ (i - 1) * 9
Case "A" : b = b + 16 ^ (i - 1) * 10
Case "B" : b = b + 16 ^ (i - 1) * 11
Case "C" : b = b + 16 ^ (i - 1) * 12
Case "D" : b = b + 16 ^ (i - 1) * 13
Case "E" : b = b + 16 ^ (i - 1) * 14
Case "F" : b = b + 16 ^ (i - 1) * 15
End Select
Next i
H2D = b
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
RichTextBox1.Font = New Font("Cambria", 20, FontStyle.Regular)
First_Unicode = H2D(TextBox1.Text)
Last_unicode = H2D(TextBox2.Text)
'display 20 characters each line
Dim i As Integer
For i = First_Unicode To Last_unicode
RichTextBox1.Text &= (ChrW(i))
If i Mod 20 = 0 Then
RichTextBox1.Text &= vbCrLf
End If
Next
End Sub
End Class
I want to give the other parameters that are mentioned in the function, and get a solution for a (the angle), but I get error: "invalid procedure call or argument" Run-time error 5.
I need to call the function in excel worksheet. It is a pretty long equation. Also, it could be that I enter a infinite loop but I don't know how to avoid that.
Function calculateangle(r, h, C, g, d, m, t, x, y As Single) As Single
Dim a As Single
a = 0
While y <> (d + r - r * Cos(a) + (x - (t - r + r * Sin(a))) * Tan(a) - (g
/ (2 * ((((C * m * (2 * g * (h - (d + r - r * Cos(a)))) ^
(1 / 2)) + m * (2 * g * (h - (d + r - r * Cos(a)))) ^ (1 / 2)) / (m +
0.04593)) ^ 2) * (Cos(a)) ^ 2)) * (x - (t - r + r * Sin(a))) ^ 2)
a = a + 0.01
Wend
MsgBox Round(a, 2)
End Function
One obvious issue is that you are using a Function but not returning a value.
This really is a complex piece of spaghetti! However, I suggest an approach like below which will help separate out various bits and thus make it easier to do debugging
Function calculateangle(<...all the bits ...>) As Double
Dim a As Double
Dim tTolerance as Double
dim f1 as Double ' sub sections to help untangle the spaghetti
Dim f2 as Double
Dim f3 as Double
Dim fFinal as Double
Dim tWithinTolerance as Boolean
tWithinTolerance = false
a = 0
tTolerance = 0.01
While not tWithinTolerance
f1 = d + r - r * Cos(a)
f2 = m*2*g*(h - f1)
f3 = x - (t - r + r * Sin(a))
fFinal = (f1 + f3 * Tan(a) - (g / (2 * ((((C * f2) ^
(1 / 2)) + f2 ^ (1 / 2)) / (m + 0.04593)) ^ 2) * (Cos(a)) ^ 2)) * f3 ^ 2)
tWithinTolerance = (Abs(y - fFinal) < tTolerance)
a = a + 0.01
Wend
Calculateangle = a ' note how this sets a return value for the function
End Function
I have left the rounding (which is a presentation issue) to the code that calls this function - this way you can display the answer to whatever level of detail you want!
(apologies if I have mangled any of the calculation on the way through - but you get the concept!)
For the author and those who want to deal with his solitaire. I hope I did not confuse anything in parentheses and simplifications.
Do
vCosA = Cos(a)
vCosADR = d + r * (1 - vCosA) ' d + r - r * vCosA '
vCosMGHADR = m * (2 * g * (h - vCosADR))
vSinAXTR = (x - (t - r * (1 - Sin(a)))) ' - r + r * Sin(a)
'((C * vCosMGHADR) + vCosMGHADR) == ((C + 1) * vCosMGHADR)
If (y = _
(vCosADR + vSinAXTR * Tan(a) - _
(g / _
(2 * _
( _
( _
((C + 1) * vCosMGHADR) / _
(m + 0.04593) _
) ^ 2 _
) * (vCosA ^ 2) _
) _
) * vSinAXTR ^ 2 _
)) Then Exit Do ' *** EXIT DO ***
a = a + 0.01
Loop
I have issue with an Excel worksheet that contains the formula:
=Spline($D$9:$D$34,$J$9:$J$34,$D43)
Sheet works fine until I open this sheet on network drive and save it on local drive. Then this formula throws #NAME? error. Strange is, that error is gone when I click on line with formula to edit it and press enter (nothing changes in formula).
Have someone met similar issue?
I just found another information. Formula spline is defined in VBA module, not internal in Excel. It looks like. But issue is still here.
Function spline(periodcol As Range, ratecol As Range, x As Range)
Dim period_count As Integer
Dim rate_count As Integer
period_count = periodcol.Rows.Count
rate_count = ratecol.Rows.Count
If period_count <> rate_count Then
spline = "Error: Range count does not match"
GoTo endnow
End If
ReDim xin(period_count) As Single
ReDim yin(period_count) As Single
Dim c As Integer
For c = 1 To period_count
xin(c) = periodcol(c)
yin(c) = ratecol(c)
Next c
Dim n As Integer
Dim i, k As Integer
Dim p, qn, sig, un As Single
ReDim u(period_count - 1) As Single
ReDim yt(period_count) As Single
n = period_count
yt(1) = 0
u(1) = 0
For i = 2 To n - 1
sig = (xin(i) - xin(i - 1)) / (xin(i + 1) - xin(i - 1))
p = sig * yt(i - 1) + 2
yt(i) = (sig - 1) / p
u(i) = (yin(i + 1) - yin(i)) / (xin(i + 1) - xin(i)) - (yin(i) - yin(i - 1)) / (xin(i) - xin(i - 1))
u(i) = (6 * u(i) / (xin(i + 1) - xin(i - 1)) - sig * u(i - 1)) / p
Next i
qn = 0
un = 0
yt(n) = (un - qn * u(n - 1)) / (qn * yt(n - 1) + 1)
For k = n - 1 To 1 Step -1
yt(k) = yt(k) * yt(k + 1) + u(k)
Next k
Dim klo, khi As Integer
Dim h, b, a As Single
klo = 1
khi = n
Do
k = khi - klo
If xin(k) > x Then
khi = k
Else
klo = k
End If
k = khi - klo
Loop While k > 1
h = xin(khi) - xin(klo)
a = (xin(khi) - x) / h
b = (x - xin(klo)) / h
y = a * yin(klo) + b * yin(khi) + ((a ^ 3 - a) * yt(klo) + (b ^ 3 - b) * yt(khi)) * (h ^ 2) / 6
spline = y
endnow:
End Function
Try to add:
Application.Volatile
to your VBA code. Add this just below the Function statement to force a renewed calculation as soon as anything changes.
I'm new to VBA, and I have a question, i.e I have a mathematical function 1 + 2x¹ + 3x² + 4x³ + ... +10x⁹ and I need to resolve it into two ways:
I can use raising operations(analog pow in Pascal) and IF statement;
without rising operations and IF statement...
I have tried this one:
Public Function test(x)
test = 1 + 2*x^1 + 3*x^2 + 4*x^3 + 5*x^4 + 6*x^5 + 7*x^6 + 8*x^7 + 9*x^8 + 10*x^9
End Function
but I think it returns the wrong answer - 2441406 with calling =test(5)
So can anyone give any advice, or help with my problem?
If you can't use VBA for this, there is a formula solution. Assuming your variable x is in cell A1, you would use this formula in another cell (I used B1):
=SUMPRODUCT(ROW($1:$10)*A1^(ROW($1:$10)-1))
When A1 = 5, it returned 23803711 as expected.
You will need * as the multiper:
Public Function test(x)
test = _
1 _
+ 2 * (x ^ 1) _
+ 3 * (x ^ 2) _
+ 4 * (x ^ 3) _
+ 5 * (x ^ 4) _
+ 6 * (x ^ 5) _
+ 7 * (x ^ 6) _
+ 8 * (x ^ 7) _
+ 9 * (x ^ 8) _
+ 10 * (x ^ 9)
End Function
I am trying to create a generic bissection method root finding user defined function called Root.
I want Root accept the following "arguments"
Root(Function, variable, lower bound, upper bound)
Root(F(a,b,c,...,Z), Z, Upper, Lower)
The Root function accepts the minimizing function with any constants and then one constant which is allowed to be varied by Root.
Function Root(ErrorFunction As String, ByRef guess As Single, A As Single, B As Single) As Single
Dim M As Single
Dim Error_A As Single
Dim Error_B As Single
Dim Error_M As Single
Dim Count As Integer
Dim Msg As Integer
A = 0.01
B = 2
M = (A + B) / 2
Error_M = 1
Count = 0
Do While Abs(Error_M / M) > 0.0000000001
Count = Count + 1
If Count = 100 Then
Exit Do
Msg = MsgBox("Did not Converge", vbOK, "Error: Convergence")
End If
Error_A = ErrorFunction(A)
Error_B = ErrorFunction(B)
Error_M = ErrorFunction(M)
If Sgn(Error_A) = Sgn(Error_M) Then
A = M
End If
If Sgn(Error_M) = Sgn(Error_B) Then
B = M
End If
M = (A + B) / 2
Loop
Root = M
End Function
Function TestErrorFunction(T As Single, P As Single, Z As Single, Gas_Comp As Range) As Single
Dim Tr As Single
Dim Pr As Single
Tr = T_Reduced(T, Gas_Comp)
Pr = P_Reduced(P, Gas_Comp)
Dim Temp As Single
Dim A
A = Array(0.3265, -1.07, -0.5339, 0.01569, -0.05165, 0.5475, -0.7361, 0.1844, 0.1056, 0.6134, 0.721)
Temp = 0.27 * Pr / (Z * Tr)
TestErrorFunction = 1 - Z + (A(0) + A(1) / Tr + A(2) / Tr ^ 3 + A(3) / Tr ^ 4 + A(4) / Tr ^ 5) * Temp + (A(5) + A(6) / Tr + A(7) / Tr ^ 2) * Temp ^ 2 - A(8) * (A(6) / Tr + A(7) / Tr ^ 2) * Temp ^ 5 + A(9) * Temp ^ 2 / Tr ^ 3 * (1 + A(10) * Temp ^ 2) * Exp(-A(10) * Temp ^ 2)
End Function