I have formula string which for instance can look like that:
dim myvalue = "somevariable1 + anothervalue * thirdvalue"
there is specific variable called : extravariable
if this variable extravariable = 0 i would like to remove it from myvalue. Note that it could be anywhere: on start/at the end or somewhere in the middle. besides operator/operators associated to it should also be removed so at the end my formula stasys correcty. Some examples could be:
dim myvalue = "extravariable * somevariable1 + anothervalue * thirdvalue"
dim myvalue = "somevariable1 + anothervalue * thirdvalue+extravariable"
dim myvalue = "somevariable1 + (extravariable * anothervalue) * thirdvalue"
so after removing it it looks like that:
dim myvalue = "somevariable1 + anothervalue * thirdvalue"
dim myvalue = "somevariable1 + anothervalue * thirdvalue"
dim myvalue = "somevariable1 + (anothervalue) * thirdvalue"
Those were just examples to catch what i mean.
The only operators which can appear inside formula are: () - + * / Pow(x,y)
How can i remove it then safely?
Related
I'm trying to make a function that takes a three digit number and reverses it (543 into 345)
I can't take that value from a TextBox because I need it to use the three numbers trick to find a value.
RVal = ReverseDigits(Val)
Diff = Val - RVal
RDiff = ReverseDigits(Diff)
OVal = Diff + RDiff
543-345=198
198+891=1089
Then it puts 1089 in a TextBox
Function ReverseDigits(ByVal Value As Integer) As Integer
' Take input as abc
' Output is (c * 100 + b * 10 + a) = cba
Dim ReturnValue As Boolean = True
Dim Val As String = CStr(InputTextBox.Text)
Dim a As Char = Val(0)
Dim b As Char = Val(1)
Dim c As Char = Val(2)
Value = (c * 100) + (b * 10) + (a)
Return ReturnValue
End Function
I've tried this but can't figure out why it won't work.
You can convert the integer to a string, reverse the string, then convert back to an integer. You may want to enforce the three digit requirement. You can validate the argument before attempting conversion
Public Function ReverseDigits(value As Integer) As Integer
If Not (value > 99 AndAlso value < 1000) Then Throw New ArgumentException("value")
Return Integer.Parse(New String(value.ToString().Reverse().ToArray()))
End Function
My code is pretty simple and will also work for numbers that don't have three digits assuming you remove that validation. To see what's wrong with your code, there are a couple of things. See the commented lines which I changed. The main issue is using Val as a variable name, then trying to index the string like Val(0). Val is a built in function to vb.net and the compiler may interpret Val(0) as a function instead of indexing a string.
Function ReverseDigits(ByVal Value As Integer) As Integer
' Dim ReturnValue As Boolean = True
' Dim Val As String = CStr(InputTextBox.Text)
Dim s As String = CStr(Value)
Dim a As Char = s(0)
Dim b As Char = s(1)
Dim c As Char = s(2)
Value = Val(c) * 100 + Val(b) * 10 + Val(a)
'Return ReturnValue
Return Value
End Function
(Or the reduced version of your function, but I would still not hard-code the indices because it's limiting your function from expanding to more or less than 3 digits)
Public Function ReverseDigits(Value As Integer) As Integer
Dim s = CStr(Value)
Return 100 * Val(s(2)) + 10 * Val(s(1)) + Val(s(0))
End Function
And you could call the function like this
Dim inputString = InputTextBox.Text
Dim inputNumber = Integer.Parse(inputString)
Dim reversedNumber = ReverseDigits(inputNumber)
Bonus: If you really want to use use math to find the reversed number, here is a version which works for any number of digits
Public Function ReverseDigits(value As Integer) As Integer
Dim s = CStr(value)
Dim result As Integer
For i = 0 To Len(s) - 1
result += CInt(Val(s(i)) * (10 ^ i))
Next
Return result
End Function
Here's a method I wrote recently when someone else posted basically the same question elsewhere, probably doing the same homework:
Private Function ReverseNumber(input As Integer) As Integer
Dim output = 0
Do Until input = 0
output = output * 10 + input Mod 10
input = input \ 10
Loop
Return output
End Function
That will work on a number of any length.
This is a long one I know but I would really appreciate the help.
I am trying to code the Newton Raphson method into VBA, Code shown below:
Code:
'Code illustrating Newton-Raphson scheme for the equation:
' f(x) = arcCos((x-BCos(H))/S)-arcSin((Bsin(H)-y)/S)
Const ep = 1E-23: Const imax = 100
Private x As Long: Private xnew As Single: Private xl As Single
Private xu As Single: Private xm As Single: Private xmold As Single: Private A As Single: Private B As Single
Private C As Single: Private D As Single
Private i As Integer
Private Failed As Boolean: Private Converged As Boolean
Sub Setup()
Failed = False
Converged = False
i = 0
End Sub
Sub NRRoot()
Set sht = Sheets("Sheet1")
For rw = 2 To 3601
x = sht.Cells(rw, 48)
Setup
Do
Dim fx As Single: Dim fprimex As Single
fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))
fprimex = -(Range("AI5") * Sin(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("O9") ^ 2) + 2 * Range("O9") * Range("AI5") * Cos(x) - (Range("AI5") ^ 2) * (Cos(x) ^ 2))) - (Range("AI5") * Cos(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("AI5") ^ 2) * (Sin(x) ^ 2) + 2 * Range("P9") * Range("AI5") * Sin(x) - (Range("P9") ^ 2)))
xnew = x - fx / fprimex
Dim er As Single
er = Abs(2 * (xnew - x) / (xnew + x))
If er < ep Then
Converged = True
ElseIf i >= imax Then
Failed = True
Else
i = i + 1
x = xnew
End If
Loop Until Converged Or Failed
If Failed Then
sht.Cells(rw, 50).Value = "Iteration failed"
Else
sht.Cells(rw, 50).Value = xnew
End If
sht.Cells(rw, 51).Value = i
Next
End Sub
Problem:
I am getting the error message: "Run-time error'13': Type Mismatch", and using the debugger it is shown on this line of code:
fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))
I think it has something to do with the Application.Acos & Application.Asin, however I am not too sure. I was having troubles with it for a while and I did some searching and found This showing that I have to put Application.Acos or Application.WorksheetFunction. The values being put in are all in radians from -pi to pi.
If it isn't because of the above text, then I think it could have something to do with the parameters that I am defining... right at the top there it says Private x As Long where maybe it has to be something else. I have tried troubleshooting, but it never really worked :(
The values in cells O9, P9, AI5, and AL5 are listed respectively: 2000, 3000, 5700, 2924.99
P.S.
The reason why I am needing to use this method is because I am trying to calculate the angles of 2 sticks when given a certain point x,y (O9,P9). I need these angles to be able to calculate the center of mass of the two sticks. Once I have the center of mass I can then finish my calculations for the project I am doing. I know there are other (much better) methods to do this problem, like wolfram mathematica, however there are other parts to the project that need to be on excel. Therefore to run everything as smooth as possible, sadly, I need to do all of this on excel.
P.P.S.
This is not my code by the way, I copied it from Here, however I think it does actually solve the Newton Raphson Method.
Solution
I had the numbers for arcSin starting at pi and going to -pi instead of 90 going to -90...
If I can figure out a better way to program the Newton Raphson Method, I will be sure to make a new post about it.
I split your codes into multiple subroutines and removed some unused variables. Run the Sub Main() will give the final results.
VBA itself has the sin and cos functions. You can use them as VBA.sin() and VBA.cos(), or simply sin() and cos(). The Acos and Asin are included in Application.WorksheetFunction, so you can use them as Application.WorksheetFunction.Acos and Application.WorksheetFunction.Asin.
In your original code of fprimex, there is an occurrence of Range("Cos(x)"), which is not the valid syntax for the Worksheet.Range property, unless you have a Range that has the name of "Cos(x)". Also, please check whether my version of fprimex matches yours since I haven't done calculus for some time.
You should be careful with cases when fPrimeX = 0, or abs(x) >= 1 when sqr(1-x^2) is on the denominator. Crude exit options for the above cases are include in the attached codes.
Option Explicit
Const ep As Double = 1E-23: Const iMax As Long = 100
Private FuncCoeffB As Double
Private FuncCoeffS As Double
Private FuncCoeffX As Double
Private FuncCoeffY As Double
Private sht As Worksheet
Private wksFunc As WorksheetFunction
Private Sub SetExcelVariables()
Set sht = Application.ThisWorkbook.Worksheets(1)
' Set sht = Sheets("Sheet1")
Set wksFunc = Application.WorksheetFunction
End Sub
Private Sub SetFunctionCoefficients()
With sht
FuncCoeffX = .Range("O9")
FuncCoeffY = .Range("P9")
FuncCoeffB = .Range("AI5")
FuncCoeffS = .Range("AL5")
End With
End Sub
Private Function fx(ArgX As Double) As Double
Dim fx1 As Double
Dim fx2 As Double
If VBA.Abs((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) > 1 Or _
VBA.Abs((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) > 1 Then
Exit Function
End If
fx1 = wksFunc.Acos((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS)
fx2 = -wksFunc.Asin((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS)
fx = fx1 + fx2
End Function
Private Function fPrimeX(ArgX As Double) As Double
Dim fPrimeX1 As Double
Dim fPrimeX2 As Double
If (((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2) >= 1 Or _
(((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2) >= 1 Then
Exit Function
End If
fPrimeX1 = _
-FuncCoeffB / FuncCoeffS * VBA.Sin(ArgX) / _
VBA.Sqr( _
1 - ((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2)
fPrimeX2 = _
-FuncCoeffB / FuncCoeffS * VBA.Cos(ArgX) / _
VBA.Sqr( _
1 - ((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2)
fPrimeX = fPrimeX1 + fPrimeX2
End Function
Private Function NewtonRaphson(ByVal ArgX As Double) As Variant
Dim ResFx As Double
Dim ResFPrimeX As Double
Dim xNew As Double
Dim er As Double
Dim iIter As Long
Dim Converged As Boolean
Dim Failed As Boolean
Dim ReturnValue As Variant
ReDim ReturnValue(1 To 1, 1 To 2) ' An array with a size of 1-by-2.
Do
ResFx = fx(ArgX)
ResFPrimeX = fPrimeX(ArgX)
If ResFPrimeX = 0 Then
Failed = True
Else
xNew = ArgX - ResFx / ResFPrimeX
End If
If xNew + ArgX = 0 Then
Failed = True
Else
er = VBA.Abs(2 * (xNew - ArgX) / (xNew + ArgX))
End If
If er < ep Then
Converged = True
ElseIf iIter >= iMax Then
Failed = True
Else
iIter = iIter + 1
ArgX = xNew
End If
Loop Until Converged Or Failed
If Failed Then
ReturnValue(1, 1) = "Iteration failed"
Else
ReturnValue(1, 1) = xNew
End If
ReturnValue(1, 2) = iIter
NewtonRaphson = ReturnValue
End Function
Sub Main()
Dim rw As Long
Dim rngTarget As Excel.Range
Dim rngResult As Excel.Range
Dim xValue As Double
Call SetExcelVariables
Call SetFunctionCoefficients
For rw = 2 To 12
Set rngTarget = sht.Cells(rw, 48)
xValue = rngTarget.Value
Set rngResult = rngTarget.Offset(0, 2).Resize(1, 2)
rngResult.Value = NewtonRaphson(xValue)
Next rw
End Sub
I get a compile error at the last line when testing the following: (Only public user defined types that are defined in a public object module can be coerced to or from a variant or passed to late-bound functions.)
Option Explicit
Public Type aType
P_Col As Integer
P_Rad As Single
P_X As Single
P_Y As Single
End Type
Function MakePatterns() As Variant
Dim i As Integer
Dim circles() As aType
For i = 1 To 5
ReDim Preserve circles(i)
circles(i).P_Col = Int(i / 2)
circles(i).P_Rad = i
circles(i).P_X = i * 10 + 1
circles(i).P_Y = i * 10 + 5
Next
For i = 1 To 5
Debug.Print circles(i).P_Col; circles(i).P_Rad; _
circles(i).P_X; circles(i).P_Y
Next
MakePatterns = circles
End Function
Is there a way to use TYPE and Function together to return an array? Or is there a more effective way?
In the code below Sub "TestCallFunction" calls the Function "MakePatterns", and after it prints the first array received back from the function in the Immediate window.
Option Explicit
Public Type aType
P_Col As Integer
P_Rad As Single
P_X As Single
P_Y As Single
End Type
Sub TestCallFunction()
Dim x() As aType
Dim i As Integer
x = MakePatterns
' print the first result received from Function MakePatterns
Debug.Print x(1).P_Col & ";" & x(1).P_Rad & ";" & x(1).P_X & ";" & x(1).P_Y
End Sub
Public Function MakePatterns() As aType()
Dim i As Integer
Dim circles() As aType
For i = 1 To 5
ReDim Preserve circles(i)
circles(i).P_Col = Int(i / 2)
circles(i).P_Rad = i
circles(i).P_X = i * 10 + 1
circles(i).P_Y = i * 10 + 5
Next
For i = 1 To 5
Debug.Print circles(i).P_Col; circles(i).P_Rad; _
circles(i).P_X; circles(i).P_Y
Next
MakePatterns = circles
End Function
I have following string, and would need to extract the X and Y values cut to a single digit after the point.
A234X78.027Y141.864D1234.2
There are a few variables that can change here:
the string can have any length and contain any number of values
I know that X and Y are Always present, but they do not have to be in a specific order in the string
Each value for X or Y can have any lenght.. for example x can be 1.1 or 1234.1
it is not imperative that X or Y do have a point. it can also be a round number, for example X78Y141.34561 (note that X has no point) If there is no point I am ok with the value, but if there is a point then I would need the first digit after the point. (rounded)
As a Result of the above string I would need two string variables containing the values 78.0 and 141.9
EDIT: Updated the last sentence, the variables should contain JUST the value, no X and Y. Sorry for the mistake
Update, code as requested
Dim objReader As New System.IO.StreamReader(FILE_NAME)
Do While objReader.Peek() <> -1
Dim curline As String = objReader.ReadLine() 'curline = G1X39.594Y234.826F1800.0
If curline.Contains("X") Then
Dim t As String = ExtractPoint(curline, "X"c) 't = "39.594"
Dim d As Double = Math.Round(Convert.ToDouble(t), 1) 'd= 39594.0
destx = d * 10 'destx = 395940
End If
Loop
Function ExtractPoint(dataString As String, character As Char) As String
Dim substring As String = String.Empty
Dim xIndex As Integer = dataString.IndexOf(character) + 1
substring += dataString(xIndex)
xIndex = xIndex + 1
While (xIndex < dataString.Length AndAlso Char.IsLetter(dataString(xIndex)) = False)
substring += dataString(xIndex)
xIndex = xIndex + 1
End While
Return substring
End Function
Your sample data indicates that fields are separated by letters, and the last letter ends with the string. Knowing that you can parse your desired letters out manually and round to 1 decimal point.
This also takes into account when there is no decimal point, but it will display a .0 at the end of the number.
EDIT
Moved common code to a function
Update
Doesn't include the letter as part of the output
Sub Main()
Dim dataString As String = "G1X39.594Y234.826F1800.0"
Dim xString As String = ExtractPoint(dataString, "X"c)
Dim yString As String = ExtractPoint(dataString, "Y"c)
Dim xDouble As Double = Math.Round(Convert.ToDouble(xString), 1)
Dim yDouble As Double = Math.Round(Convert.ToDouble(yString), 1)
Console.WriteLine(xDouble.ToString("F1"))
Console.WriteLine(yDouble.ToString("F1"))
Console.WriteLine((xDouble * 10).ToString("F1"))
Console.WriteLine((yDouble * 10).ToString("F1"))
Console.ReadLine()
End Sub
Function ExtractPoint(dataString As String, character As Char) As String
Dim substring As String = String.Empty
Dim xIndex As Integer = dataString.IndexOf(character) + 1
substring += dataString(xIndex)
xIndex = xIndex + 1
While (xIndex < dataString.Length AndAlso Char.IsLetter(dataString(xIndex)) = False)
substring += dataString(xIndex)
xIndex = xIndex + 1
End While
Return substring
End Function
Results:
Have you looked into Regular Expressions?
Dim x As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(TextBox1.Text, "X\d+([.]\d{1})?")
Dim y As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(TextBox1.Text, "Y\d+([.]\d{1})?")
MsgBox(x.ToString & " -- " & y.ToString)
I believe this will do what you are looking for if I understood correctly.
EDIT For Only getting the numbers after X and Y
Based off my original code, you could do something like this.
This also rounds the numbers to the nearest one decimal place.
Dim x As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(TextBox1.Text, "X(\d+([.]\d{2})?)")
Dim y As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(TextBox1.Text, "Y(\d+([.]\d{2})?)")
MsgBox(Math.Round(CDbl(x.Groups(1).Value), 1) & " -- " & Math.Round(CDbl(y.Groups(1).Value), 1))
Updated code for added code
Dim s As String = "A234X78.027Y141.864D1234.2"
Dim dX As Double = Extract(s, "X")
Dim dY As Double = Extract(s, "Y")
MsgBox(dX * 10 & "-" & dY * 10)
Private Function Extract(ByRef a As String, ByRef l As String) As Double
Dim x As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(a, l & "(\d+([.]\d{2})?)")
Return Math.Round(CDbl(x.Groups(1).Value), 1)
End Function
Here is a simple LINQ function that should do it for you (no regex, no long code):
Private Function ExtractX(s As String, symbol As Char) As String
Dim XPos = s.IndexOf(symbol)
Dim s1 = s.Substring(XPos + 1).TakeWhile(Function(c) Char.IsDigit(c)).ToArray()
If (XPos + 1 + s1.Length < s.Length) AndAlso s.Substring(XPos + 1 + s1.Length)(0) = "."c AndAlso Char.IsDigit(s.Substring(XPos + 1 + s1.Length)(1)) Then
Return String.Join("", s1, s.Substring(XPos + 1 + s1.Length, 2))
Else
Return s1
End If
End Function
Call it like this:
Dim s = "A234X78.027Y141.864D1234.2"
Dim x = ExtractX(s, "X"c)
Dim y = ExtractX(s, "Y"c)
Public Function random_key(ByVal lenght As Integer) As String
Randomize()
Dim s As New System.Text.StringBuilder("")
Dim b() As Char = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".ToCharArray()
For i As Integer = 1 To lenght
Randomize()
Dim z As Integer = Int(((b.Length - 2) - 0 + 1) * Rnd()) + 1
s.Append(b(z))
Next
Return s.ToString
Console.WriteLine(s.ToString)
End Function
i wanna print it like
s=textbox1.text or somethhing...
What wrong with using Console.WriteLine?
Note that you should not put it behind the return statement in the method because code behind a return is unreachable.
Dim random As String = random_key(10)
Console.WriteLine(random)