I'm having two problems here. First off all I want to x to change values to x - y and if the new X is higher then 0 i want the process to repeat itself. I've worked out the code below but i'm not certiant on two things.
Am I even allowed to make the equation x = x - y or does this mess up everything? I mean in mathematical terms it would not be possible but if we take X as Hp and Y as damage I want the damage to add up. I don't want it to create an "damage HP" integer for every subtraction as I even don't know how many "Z = x - y" style equations I would have to create if I set Y to be random.
My guess is that I could create a Z integral that would copy X a moment before the subtraction would go off and then have the subtraction be X = Z - Y but I'm not sure how I would go about coding this.
I want it to go ahead and loop itself if X is higher then 0 and I'm not sure if I coded that correctly.
Here is my code:
Module Module1
Dim A As Integer
Dim B As Integer
Dim x As Integer
Dim y As Integer
Sub Main()
End Sub
Sub Maths()
A = 5
B = 4
x = 3
y = 1
Subtraction()
Console.WriteLine("You deal {0} damage to your enemy reducing it to {1} hp.", y, x)
Do Until x <= 0
Loop
End Sub
Private Sub Subtraction()
If A > B Then x = x -y
Return
End Sub
End Module
I liked this question. Here's my thoughts:
Yes, x = x - y is perfectly valid code. It's no different than if I had a string variable named myRunOnSentence and I wanted to concatenate the string that was already in the variable and another string and then store the results back in the string variable. Like this: myRunOnSentence = myRunOnSentence + "another string" Same concept, just change the datatype to an Integer. x = x + y. That programatically says: "take the value in x and the value in y, add them together, and store the result of that expression in x."
You did indeed make a mistake with the loop. You don't have any code inside the body of the loop itself.
You have nothing happening in the Main() sub of your module so this module when run will do nothing. You should just take the code from the Maths() method and put it in the Main() sub.
In your Subtraction() method, A > B will always evaluate to True because A and B are initialized with values and then never changed.
Your code should look something like this:
Module Module1
Dim A As Integer = 5
Dim B As Integer = 4
Dim x As Integer = 3
Dim y As Integer = 1
Sub Main()
Do Until x <= 0
Subtraction()
Console.WriteLine("You deal {0} damage to your enemy reducing it to {1} hp.", y, x)
Loop
End Sub
Private Sub Subtraction()
If A > B Then x = x - y 'Return statement wasn't needed.
End Sub
End Module
If this answered your question, please don't forget to mark it as the answer.
Related
Closed. This question needs debugging details. It is not currently accepting answers.
Edit the question to include desired behavior, a specific problem or error, and the shortest code necessary to reproduce the problem. This will help others answer the question.
Closed 3 years ago.
Improve this question
Here is my code for a bisection method. If I input 4 and 5 the program loops infinitely. There is a problem with it running.
Sub TheBisectionMethod1()
Dim a, b As Double 'Taking two variables, A and B
Console.Write(vbLf & "Input A: ")
a = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for A
Console.Write(vbLf & "Input B: ")
b = Double.Parse(Console.ReadLine()) 'This is where user inputs and value stored for B
line1:
Dim c As Double
c = (a + b) / 2 'declearing variable c for the sum of half of the user entered values
If ((Math.Abs(func(c))) < 0.0001) Then 'in flow chart the value of C remians unchange so the program will not run, so it will run if i is >0.0001
Console.Write(vbLf & "C : {0}", c)
ElseIf (Math.Sign(func(c)) = Math.Sign(func(a))) Then
Console.WriteLine("Hello")
a = c
GoTo line1
ElseIf (Math.Sign(func(c)) <> Math.Sign(func(a))) Then
b = c
GoTo line1
End If
End Sub
Function func(x As Double) As Double
Dim y As Double
y = x ^ 2 - 2
Return y
End Function
Don't use a GoTo. There's no need. Also, remove the user interaction from the method that does the actual work. Read the data in one place, pass it to a method (usually a Function rather than a Sub) that does the work and returns a result, and then show the result to the user after the function ends.
That makes this question tricky, because the only result we see in the original code is writing "Hello" to the Console, and that's clearly just a debugging statement. What do you want this code to do? (I'm gonna assume you mean this)
Function Bisect(a as Double, b As Double) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = func(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(func(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = func(c)
End While
Return c
End Function
Function func(x As Double) As Double
Return x ^ 2 - 2
End Function
And really, it should look like this:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
Dim d As Double = f(c)
While Math.Abs(d) >= 0.0001
If Math.Sign(d) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
c = (a + b) / 2
d = f(c)
End While
Return c
End Function
and be called like this:
Bisect(a, b, Function(x) x ^ 2 - 2)
Also, the algorithm here is slightly off based the wikipedia article. This is more precise:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim TOL As Double = 0.0001
Dim MaxSteps As Integer = 1000
Dim c As Double = (a + b) / 2
While Math.Abs(f(c)) >= TOL AndAlso (b-a)/2 >= TOL AndAlso MaxSteps > 0
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
a = c
Else
b = c
End If
MaxSteps -= 1
c = (a + b) / 2
End While
If MaxSteps = 0 Then
Throw New ArgumentException("The bisection fails to converge within the allowed time for the supplied arguments.")
End If
Return c
End Function
I bring it up, because the complaint in the original question is this:
the program loops infinently[sic]
and one of the tenants of the algorithm is it's not guaranteed to converge, hence the step counter.
Finally, this looks to me like it might do well as a recursive function. Recursion can improve things here because we can rely on the call stack overflowing rather than needing to implement a step counter:
Function Bisect(a as Double, b As Double, f As Function(Of Double, Double)) As Double
Dim c As Double = (a + b) / 2
If Math.Abs(f(c)) < TOL OrElse (b-a)/2 < TOL Then Return c
If Math.Sign(f(c)) = Math.Sign(f(a)) Then
Return Bisect(c, b, f)
Else
Return Bisect(a, c, f)
End If
End Function
Of course, catching that StackOverflowException is a trick in itself, so you may still want that step counter. But I need to leave something for you to do yourself.
This also helps demonstrate part of why I recommend removing all user I/O from the Bisect() method. If this method were also responsible for talking to the end user, it would not be possible to even consider the recursive option, where the code is clearly far shorter and simpler than any of the others.
I'm trying to write a program which will find all the values of x and y which will satisfy the condition of x + 2*y equalling say 5. I've given this simple example for the sake of clarity.
Note: I've used nested calls successfully but the program to me looks messy and ill-structured.
In an effort to clean up the structure of my coding I've tried to code the following without much success. Is there any way the following can be done in VBA and how is it done? I have my back against the wall and am hoping that you can help, please.
Please note that the following is not meant to be code but a way of explaining my query. So here is what I envisage to clean up the structure (Simplified for clarity):
Sub sbCaller()
Call sbForLoop()
Call sbMakeEquation()
Call sbTestEquation()
Call sbTabulate()
End Sub
from sbCaller() execute Call sbForLoop()
'simplified for the sake of clarity:-
For x = 1 To 4
For y = 1 To 4
'Go back to Sub sbCaller() to execute sbMakeEquation()
Result = x + 2*y
'back in sbTestEquation()
If Result = 5 Then go back to Sub sbCaller() to execute sbTabulate()
if Result<> 5 Then go back to Sub sbForLoop to resume execution at
'point HERE to execute the next iteration.
I believe the approach you propose is too complicated. Especially if you intend to stick with "Sub" instead of "Function".
The following separates the steps, which is what I understand you to want, without needing to jump back-and-forth within the same procedure.
Sub sbCaller()
sbForLoop
End Sub
Sub sbForLoop()
Dim result As Long
Dim x As Long
Dim y As Long
For x = 1 To 4
For y = 1 To 4
result = x + 2 * y
sbTestEquation result, x, y
Next y
Next x
End Sub
Function sbTestEquation(result As Long, x As Long, y As Long) As Boolean
Dim bOK As Boolean
If result = 5 Then
sbTabulate result, x, y
bOK = True
Else
bOK = False
End If
sbTestEquation = bOK
End Function
Sub sbTabulate(result As Long, x As Long, y As Long)
Debug.Print result, x, y
End Sub
I am a bit confused as to how to implement code for Text boxes. I am trying to set up a form which displays a text box, for which the user has the option to enter in the values (parameters) , which then are entered into another subprogram and runs that subprogram. For example, in the following code:
Option Explicit
Sub FillSampleTable()
'This will fill an x by y grid of numbers incrementing to use for testing purposes
Dim x As Double
Dim y As Double
Dim z As Double
Dim OffsetColumn As Integer
Dim offsetrows As Integer
Dim a As Long
Application.ScreenUpdating = False
a = 10
OffsetColumn = 1
offsetrows = 1
z = 0
For x = 1 To a
For y = 1 To a
z = z + 1
Cells(x + offsetrows, y + OffsetColumn).Select
Cells(x + offsetrows, y + OffsetColumn).Value = z
Next y
Next x
Application.ScreenUpdating = True
End Sub
I would want to have a text box to prompt the user for the value of 'a', and once that value is loaded, then this subprogram is run. If no value is entered, then it would shoot an error msgbox and return to the entry screen.
When I click the box I get:
Private Sub GridSize_Change()
'I renamed text box GridSize
End Sub
but don't know what to do with this. MS Excel v 2016.
What you need is an inputbox.
You could do a simple :
a = InputBox("Enter number a")
Since you need a to be a positive integer, you should at least specify the datatype accepted by the inputbox to 1 (number). But you probably also need to make sure it is a positive integer.
I am trying to check whether a given number is cuberoot or not in VBA.
The following code works only for 2 and 3 as answers, it does not work after that.
I am trying to figure out what is wrong in the code.
Sub cuberoot()
Dim n As Long, p As Long, x As Long, y As Long
x = InputBox("x= ")
If Iscube(x) Then
MsgBox ("Is cube")
Else
MsgBox ("No cube")
End If
End Sub
Private Function Iscube(a As Long) As Boolean
b = a ^ (1 / 3)
If b = Int(b) Then
Iscube = True
Else
Iscube = False
End If
End Function
Since you are passing in a Long I'll assume that you won't have a number bigger than roughly 2*10^9 so this should always work. It's a slight variation where you truncate the double and then compare to the two nearest integers to make sure you catch any rounding errors.
Edit: In VBA the truncating would always round so it's only neccessary to check the 3rd root value:
Public Function Iscube(a As Long) As Boolean
Dim b As Integer
b = CInt(a ^ (1# / 3#))
If (b ^ 3 = a) Then
Iscube = True
Else
Iscube = False
End If
End Function
If you need a number larger than a Long you'll need to change your input type and you might want to consider an iterative method like a binary search or a Newton-Raphson solver instead.
Existing Code
Your code will work if you add a
dim b as long
If you debug your code you will see that feeding in 125 gives you
b = 5
Int(b) = 4
Updated Code
You can shorten your boolean test to this
Function Iscube(lngIn As Long) As Boolean
Iscube = (Val(lngIn ^ (1 / 3)) = Int(Val(lngIn ^ (1 / 3))))
End Function
Note that if you call it with a double, it will opearte on the long portion only (so it would see IsCube(64.01)as IsCube(64))
Option Explicit
Sub peuler1()
Dim x As Variant
Dim y As Variant
y = 0
For x = 1 To 999
If x Mod 3 = 0 Or x Mod 5 = 0 Then
y = y + x
End If
Next x
Call peuler1
End Sub
Why is this taking so long? it doesn't seem to be too convoluted.
I believe you are in a recursive loop.
Remove Call peuler1
You are calling your subroutine from within itself. That's going to give you an infinite loop.
Because you seem to call function peuler1 inside its definition, you then keep going recursively until you fill up stack space.
(I don't use visual basic, just a guess)
How about this?
Option Explicit
Function peuler1() as integer
Dim x As integer
Dim y As integer
y = 0
For x = 1 To 999
If x Mod 3 = 0 Or x Mod 5 = 0 Then y = y + x
Next x
pueler1=y
End Sub
This procedure is a function, which means it returns a value (Subs do stuff. Functions calculate something). Adding peuler1=y at the bottom makes the function return the value of y. The advantage of this is that you can now call this procedure from another procedure.
If you are working on this in the standard MS Office VBA Editor, you can get your answer by typing debug.print peuler1 in the Immmediate window.
Move the Call peuler1 outside of the End Sub. You're calling peuler1 when you get to the end of peuler1, and never get to the end of it.