I got a task in university, but have no idea how to solve it. Need help.
Tried to solve it with cycle, but dont think that its right.
For k = 1 To 10
For i = 1 To k
n! = 1 * 2 * n
S = S * S * sin (2i + 10) / n!
If I understood properly, it should be something like this:
Sub test()
Dim i As Long
Dim k As Long
Dim Numerator As Double
Dim Result As Double
For k = 1 To 10 Step 1
Numerator = 0
For i = 1 To k Step 1
Numerator = Numerator + Sin(2 * i + 10)
Next i
Result = Result + Numerator / Application.WorksheetFunction.Fact(k)
Next k
Debug.Print Result
End Sub
Related
Trying to sum 2^i from i=0 to i=n on VBA. Where n is an entered value by the user each time
I can get it to do each term individually but its not summing.
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim array as
Dim CSeriesSum As Double
ActiveCell.Value = WorksheetFunction.SeriesSum(Arg1:=2, Arg2:=n, Arg3:=1, Arg4:=1:n)
End Sub
I expect it to return for eg. 1 if n=0, 3 if n=1, 7 if n=2 etc.
Maybe try this loop:
Sub Button1()
Dim n As Single
n = InputBox("Enter a value for n")
Dim val As Long
val = 0
For i = 0 To n
val = val + 2 ^ i
Next
ActiveCell.Value = val
End Sub
In addition to the loop-based approach, you can use the fact that the series
1 + 2 + 2^2 + ... + 2^n + ...
is a geometric series whose partial sums can be expressed in closed-form. In this case the partial sum that you are evaluating is equal to 2^(n+1)-1. For example, if n = 3, it is easy to verify that
1 + 2 + 4 + 8 = 15 = 16-1 = 2^4 - 1
This leads to the following code:
Sub Button1()
Dim n As Long
n = InputBox("Enter a value for n")
ActiveCell.Value = 2 ^ (n + 1) - 1
End Sub
I am trying to get a specific value from an excel chart. This is the code which creates my chart (I created a reversed binomial distribution plot) :
Dim lim As String
Dim N As Long
N = Range("C4").Value
Dim x, s, p As Double
x = Range("C6") 'event number
s = Range("C5") 'sample size
Dim g() As Long
Dim h() As Double
Dim k() As Double
Dim prob() As Double
ReDim g(N)
ReDim prob(N)
ReDim h(N)
ReDim k(N)
For i = 1 To N
g(i) = i
h(i) = i / N
k(i) = 1 - h(i)
prob(i) = WorksheetFunction.BinomDist(x, s, h(i), False) * 100
End If
And here is chart:
I need the point where y is 0 on distribution curve second time.
At the end of your For Loop, you could check if prob(i) = 0 And Prob(i-1) > 0, and save the index of this point. It's "too" simple, yet if this is just for this kind of distribution, it do the job :
Dim targetIndex As Integer
For i = 1 To N
g(i) = i
h(i) = i / N
k(i) = 1 - h(i)
prob(i) = WorksheetFunction.BinomDist(x, s, h(i), False) * 100
If i > 1 Then 'check if this is not the first point
If prob(i) = 0 And prob(i-1) <> 0 Then targetIndex = i
End If
Next
'// Now your point is the couple (targetIndex, prob(targetIndex))
I am working with VBA for Excel.
I get the "Application defined or object defined" error each time I run this code.
Here it is:
Sub Test()
Dim i As Integer, j As Integer, k As Integer, l As Integer, t As Integer
Dim row As Integer
Dim Maturite As Integer
Dim tsup As Double, tinf As Double
Dim datetaux As Date, datejouissance As Date
Dim taux As Double
For i = 2 To 770
Maturite = Sheets("Em").Cells(i, 19)
datejouissance = Sheets("Em").Cells(i, 14)
For l = 2 To 255
For k = 0 To 10
For t = 1 To 10
row = 13 * k + 2
datetaux = Sheets("TSR").Cells(row, l)
taux = Sheets("TSR").Cells(13 * k + 3, l)
If taux <> 0 Then
If datejouissance = datetaux Then
If 91 <= Maturite And Maturite <= 182 Then
tsup = Sheets("TSR").Cells(row + 2, j)
tinf = Sheets("TSR").Cells(row + 1, j)
Sheets("Em").Cells(i, 21).Value = ((tsup - tinf) * (Maturite - 91) / (182 - 91)) + tinf
End If
End If
End If
Next
Next
Next
Next
End Sub
I get the error at :
tsup = Sheets("TSR").Cells(row + 2, j)
I tried using :
tsup = Sheets("TSR").Cells(row + 2, j).Value
The type of Sheets("TSR").Cells(row + 2, j).Value is Double.
But it's not working. I can't seem to understand what the problem is.
Thanks in advance
I think you may need to check the value of j. As far as I can see from your code its value remains 0. Column 0 does not exist and will lead to the given error.
You address the cell using the integer j, but you don't assign a value to j.
Thus, VBA fills it with the standart value for integers: 0, directing your call to Sheets("TSR").Cells(row + 2, 0) and producing an error.
I am lookin for a solution to find cubic roots in Excel. I found the below code at this website.
http://www.mrexcel.com/forum/excel-questions/88804-solving-equations-excel.html
unfortunately, it doesn't work for me - I get #VALUE! when I run it and since I am only learning VBA, I have not had luck debugging it.
Sub QUBIC(P As Double, Q As Double, R As Double, ROOT() As Double)
' Q U B I C - Solves a cubic equation of the form:
' y^3 + Py^2 + Qy + R = 0 for real roots.
' Inputs:
' P,Q,R Coefficients of polynomial.
' Outputs:
' ROOT 3-vector containing only real roots.
' NROOTS The number of roots found. The real roots
' found will be in the first elements of ROOT.
' Method: Closed form employing trigonometric and Cardan
' methods as appropriate.
' Note: To translate and equation of the form:
' O'y^3 + P'y^2 + Q'y + R' = 0 into the form above,
' simply divide thru by O', i.e. P = P'/O', Q = Q'/O',
' etc.
Dim Z(3) As Double
Dim p2 As Double
Dim RMS As Double
Dim A As Double
Dim B As Double
Dim nRoots As Integer
Dim DISCR As Double
Dim t1 As Double
Dim t2 As Double
Dim RATIO As Double
Dim SUM As Double
Dim DIF As Double
Dim AD3 As Double
Dim E0 As Double
Dim CPhi As Double
Dim PhiD3 As Double
Dim PD3 As Double
Const DEG120 = 2.09439510239319
Const Tolerance = 0.00001
Const Tol2 = 1E-20
' ... Translate equation into the form Z^3 + aZ + b = 0
p2 = P ^ 2
A = Q - p2 / 3
B = P * (2 * p2 - 9 * Q) / 27 + R
RMS = Sqr(A ^ 2 + B ^ 2)
If RMS < Tol2 Then
' ... Three equal roots
nRoots = 3
ReDim ROOT(0 To nRoots)
For i = 1 To 3
ROOT(i) = -P / 3
Next i
Exit Sub
End If
DISCR = (A / 3) ^ 3 + (B / 2) ^ 2
If DISCR > 0 Then
t1 = -B / 2
t2 = Sqr(DISCR)
If t1 = 0 Then
RATIO = 1
Else
RATIO = t2 / t1
End If
If Abs(RATIO) < Tolerance Then
' ... Three real roots, two (2 and 3) equal.
nRoots = 3
Z(1) = 2 * QBRT(t1)
Z(2) = QBRT(-t1)
Z(3) = Z(2)
Else
' ... One real root, two complex. Solve using Cardan formula.
nRoots = 1
SUM = t1 + t2
DIF = t1 - t2
Z(1) = QBRT(SUM) + QBRT(DIF)
End If
Else
' ... Three real unequal roots. Solve using trigonometric method.
nRoots = 3
AD3 = A / 3#
E0 = 2# * Sqr(-AD3)
CPhi = -B / (2# * Sqr(-AD3 ^ 3))
PhiD3 = Acos(CPhi) / 3#
Z(1) = E0 * Cos(PhiD3)
Z(2) = E0 * Cos(PhiD3 + DEG120)
Z(3) = E0 * Cos(PhiD3 - DEG120)
End If
' ... Now translate back to roots of original equation
PD3 = P / 3
ReDim ROOT(0 To nRoots)
For i = 1 To nRoots
ROOT(i) = Z(i) - PD3
Next i
End Sub
Function QBRT(X As Double) As Double
' Signed cube root function. Used by Qubic procedure.
QBRT = Abs(X) ^ (1 / 3) * Sgn(X)
End Function
Can anyone please guide me on how to fix it, so I can run it. Thanks.
EDIT: This is how I am running it in Excel (I changed Qubic to be a function instead of sub)
cells A1:A3 contain p,q, r respectively
cells B1:B3 contain Roots()
cells C1:C3 contain array for the output of Qubic
A1:1
A2:1
A3:1
B1:0.1
B2:0.1
B3:0.1
C1:
C2:
C3:
{=QUBIC(A1,A2,A3,B1:B3)}
ADD: now that it works with the fix from #assylias, I am trying the following from another sheet:
Function ParamAlpha(p,q,r) as Double
Dim p as Double
Dim q as Double
Dim r as Double
p=-5
q=-2
r=24
Dim Alpha as Double
Dim AlphaVector() as Double
AlphaVector=QubicFunction(p,q,r)
Alpha=FindMinPositiveValue(AlphaVector)
End Function
Function FindMinPositiveValue(AlphaVector) As Double
Dim N As Integer, i As Integer
N = AlphaVector.Cells.Count
Dim Alpha() As Double
ReDim Alpha(N) As Double
For i = 1 To N
If AlphaVector(i) > 0 Then
Alpha(i) = AlphaVector(i)
Else
Alpha(i) = 100000000000#
End If
Next i
FindMinPositiveValue = Application.Min(Alpha)
End Function
In Excel, I call =ParamAlpha(-5,-2,24) and it returns #VALUE!
If you add the following procedure, it will show the results in a message box. You can then modify it to do something else as you require:
Public Sub test()
Dim p As Double
Dim q As Double
Dim r As Double
Dim roots() As Double
p = 1
q = 1
r = 1
QUBIC p, q, r, roots
Dim i As Long
Dim result As String
result = "("
For i = LBound(roots, 1) To UBound(roots, 1)
result = result & roots(i) & ","
Next i
result = Left(result, Len(result) - 1) & ")"
MsgBox "Roots of y^3 + " & p & ".y^2 + " & r & ".y + " & r & " = 0 has the following roots: " & result
End Sub
Alternatively, if you want the result in the form of a fomula array directly in a spreadsheet, you can add the following function in the same module:
Public Function QubicFunction(p As Double, q As Double, r As Double) As Double()
Dim roots() As Double
QUBIC p, q, r, roots
QubicFunction = roots
End Function
You then call it from Excel by selecting a few cells (horizontally, for example A1:B1) and press CTRL+SHIFT+ENTER:
=QubicFunction(1, 1, 1)
I am trying to do some prime factorisation with my VBA excel and I am hitting the limit of the long data type -
Runtime Error 6 Overflow
Is there any way to get around this and still stay within VBA? I am aware that the obvious one would be to use another more appropriate programming language.
Lance's solution works in so far that I am able to get the big numbers into the variables now. However, when I try to apply the MOD function - bignumber MOD 2, for example - it still fails with error message
Runtime Error 6 Overflow
You can use Decimal data type. Quick hint from google: http://www.ozgrid.com/VBA/convert-to-decimal.htm
This is my Decimals.cls (VB6):
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "Decimals"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'local variable(s) to hold property value(s)
Private mvarDec As Variant 'local copy
Public Property Let Dec(ByVal vData As Variant)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.Dec = 5
mvarDec = CDec(vData)
End Property
Public Property Get Dec() As Variant
Attribute Dec.VB_UserMemId = 0
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Dec
Dec = CDec(mvarDec)
End Property
and this is a testing program. The class has been setup so that you don't have to qualify with .Dec() on get and let.
Dim dec1 As New Std.Decimals
Dim dec2 As New Std.Decimals
Dim dec3 As New Std.Decimals
Dim modulus As New Std.Decimals
Sub main()
dec1 = "1000.000000001"
dec2 = "1000.00000000000001"
dec3 = dec1 + dec2
Debug.Print dec1
Debug.Print dec2
Debug.Print dec3
Debug.Print dec3 * dec3
Debug.Print dec3 / 10
Debug.Print dec3 / 100
Debug.Print Sqr(dec3)
modulus = dec1 - Int(dec1 / dec2) * dec2
Debug.Print modulus
End Sub
and sample run
1000.000000001
1000.00000000000001
2000.00000000100001
4000000.000004000040000001
200.000000000100001
20.0000000000100001
44.721359550007
0.00000000099999
1000.000000001
1000.00000000000001
2000.00000000100001
4000000.000004000040000001
200.000000000100001
20.0000000000100001
44.721359550007
0.00000000099999
Here is my "big multiply" routine for multiplying arbitrarily large numbers (eg 100 characters long). It works by splitting the input numbers, which are strings, into chunks of 7 digits (because then it can cross multiply them and store the results in Doubles).
eg bigmultiply("1934567803945969696433","4483838382211678") = 8674289372323895422678848864807544574
Function BigMultiply(ByVal s1 As String, ByVal s2 As String) As String
Dim x As Long
x = 7
Dim n1 As Long, n2 As Long, n As Long
n1 = Int(Len(s1) / x + 0.999999)
n2 = Int(Len(s2) / x + 0.999999)
n = n1 + n2
Dim i As Long, j As Long
ReDim za1(n1) As Double
i = Len(s1) Mod x
If i = 0 Then i = x
za1(1) = Left(s1, i)
i = i + 1
For j = 2 To n1
za1(j) = Mid(s1, i, x)
i = i + x
Next j
ReDim za2(n2) As Double
i = Len(s2) Mod x
If i = 0 Then i = x
za2(1) = Left(s2, i)
i = i + 1
For j = 2 To n2
za2(j) = Mid(s2, i, x)
i = i + x
Next j
ReDim z(n) As Double
Dim u1 As Long, u2 As Long
Dim e As String
e = String(x, "0")
For u1 = 1 To n1
i = u1
For u2 = 1 To n2
i = i + 1
z(i) = z(i) + za1(u1) * za2(u2)
Next u2
Next u1
Dim s As String, y As Double, w As Double, m As Long
m = n * x
s = String(m, "0")
y = 10 ^ x
For i = n To 1 Step -1
w = Int(z(i) / y)
Mid(s, i * x - x + 1, x) = Format(z(i) - w * y, e)
z(i - 1) = z(i - 1) + w
Next i
'truncate leading zeros
For i = 1 To m
If Mid$(s, i, 1) <> "0" Then Exit For
Next i
If i > m Then
BigMultiply = ""
Else
BigMultiply = Mid$(s, i)
End If
End Function
MOD is trying to convert your DECIMAL type to LONG before operating on it. You may need to write your own MOD function for the DECIMAL type. You might try this:
r = A - Int(A / B) * B
where A & B are DECIMAL subtype of VARIANT variables, and r might have to be that large also (depending on your needs), though I only tested on a long.