I am not able to retrieve the coefficients for a second order linest function and the MsgBox returns an error : "Type mismatch".
I expect the linest function to give {0,0,1} as I used the square function f:x->x² for this example.
Sub RunLinestOld()
Dim vectorX() As Double
Dim vectorY() As Double
Dim theLeastSquareCoef
'redimensionne les vecteurs
ReDim vectorX(1 To 4)
ReDim vectorY(1 To 4)
vectorX(1) = 1
vectorX(2) = 2
vectorX(3) = 3
vectorX(4) = 4
vectorY(1) = 1
vectorY(2) = 4
vectorY(3) = 9
vectorY(4) = 16
'theLeastSquareCoef = Application.LinEst(vectorY, vectorX)
theLeastSquareCoef = Application.LinEst(vectorY, Application.Power(vectorX, Array(1, 2)))
**MsgBox "K is " & Application.Index(theLeastSquareCoef, 1, 2)**
End Sub
I achieved this with the below code. You need to pass matrix of dimension Nx1 to the LinEst function, and NOT a vector.
Sub RunLinEst()
Dim vectorX() As Double
Dim vectorY() As Double
Dim theLeastSquareCoef
'you need to define matrix otherwise it doesn't work
ReDim vectorX(0 To 4, 0 To 0)
ReDim vectorY(0 To 4, 0 To 0)
vectorX(0, 0) = 0
vectorX(1, 0) = 1
vectorX(2, 0) = 2
vectorX(3, 0) = 3
vectorX(4, 0) = 4
vectorY(0, 0) = 0
vectorY(1, 0) = 1
vectorY(2, 0) = 4
vectorY(3, 0) = 9
vectorY(4, 0) = 16
theLeastSquareCoef = Application.LinEst(vectorY, Application.Power(vectorX, Array(1, 2)))
Range("F4").Value = Application.Index(theLeastSquareCoef, 1)
Range("F5").Value = Application.Index(theLeastSquareCoef, 2)
Range("F6").Value = Application.Index(theLeastSquareCoef, 3)
End Sub
You need to cast the result of linest to string
MsgBox("K is " & CStr(Application.Index(theLeastSquareCoef, 1, 2)))
Related
I just started to learn VBA for a project and i have a userform where i have multiple sliders that give me values that i want to use to build a 2D Array with For loops.
My Array is 5 by 5 and it is "Symmetric" (1 as diagonal, Thus I only need one side for the values).
I obtain the matrix values after converting values obtained from sliders in the GUI, which i named Sld1v2 (for row 1, col 2), Sld1v3 (for row1, col3) etccc.
I am thus looking for a way to call the right Slider (by its custom name) in the for loops but i cannot figure how i can do it, can you help me ? I currently have a Type Error, when running the line --> JudgementMatrix(lig,col) = JudgementVector(....)
Following you can see the Excel Version of what i want to code and my attempt of a script.
I hope my request is clear :)
EDIT: By changing Variant type to Double for the Matrix and Vector (since i saw my vector had different types within). I now get an error when i call the function Array. But the thing is that Array returns a variant! --> Filled the Vector manually
Screenshot of the Excel of what i want to code
Dim JudgementVector(16) As Double
Dim JudgementMatrix(4, 4) As Double
Dim lig As Integer
Dim col As Integer
For i = 0 To 16
If i < 8 Then
JudgementVector(i) = (1 / (9 - i))
Else
If i >= 8 Then
JudgementVector(i) = i - 7
End If
End If
Next i
For lig = 0 To 4
For col = 0 To 4
If col = lig Then
JudgementMatrix(lig, col) = 1
Else
If col > lig Then
JudgementMatrix(lig, col) = JudgementVector(UserForm1.Controls(["sld"&lig&"v"&col]).Value + 8)
Else
If lig > col Then
JudgementMatrix(lig, col) = 1 / JudgementMatrix(col, lig)
End If
End If
End If
Next col
Next lig
Apparently it didnt like having "Text" & variable & "Text" & Variable
so i by passed it by creating temp values to combine step by step.
Dim JudgementVector(16) As Double
Dim JudgementMatrix(4, 4) As Double
Dim lig As Integer
Dim col As Integer
Dim Temp1 As String
Dim Temp2 As String
Dim Temp3 As String
' JudgementVector = ([{1 / 9, 1 / 8, 1 / 7, 1 / 6, 1 / 5, 1 / 4, 1 / 3, 1 / 2, 1, 2, 3, 4, 5, 6, 7, 8, 9}])
For i = 0 To 16
If i < 8 Then
JudgementVector(i) = (1 / (9 - i))
Else
If i >= 8 Then
JudgementVector(i) = i - 7
End If
End If
Next i
For lig = 0 To 4
For col = 0 To 4
If col = lig Then
JudgementMatrix(lig, col) = 1
Else
If col > lig Then
Temp1 = "sld" & lig + 1
Temp2 = "v" & col + 1
Temp3 = Temp1 & Temp2
JudgementMatrix(lig, col) = JudgementVector(UserForm1.Controls(Temp3) + 8)
Else
If lig > col Then
JudgementMatrix(lig, col) = 1 / JudgementMatrix(col, lig)
End If
End If
End If
Next col
Next lig
I have a 2D array:
Dim twod_array() As Variant
Which I want to store values from two other arrays: e.g.:
Dim arrayone As Variant
arrayone = (1, 2, 3)
Dim arraytwo As Variant
arraytwo = (4, 5, 6)
I want to loop through each element of the above arrays and add them in the below manner:
Dim count As Long
count = 0
ReDim Preserve twod_array(1,0) // initial sizing
for i = 0 To UBound(arrayone)
for j = 0 To UBound(arraytwo)
twod_array(0,count) = arrayone(i)
twod_array(1,count) = arraytwo(j)
count = count + 1
ReDim Preserve twod_array(1, count) // dynamic resizing (doesnt work)
Next j
Next i
I know at some point I have to ReDim the 2D array which I believe I can do as follows:
ReDim Preserve twod_array(1, count)
The 1 allows me to specify 2 elements in the x-dimension and the count is incremented because I don't know how many elements each one-d array will have (I just set them equal to three in this example)
For some reason, I can only output the values twod_array(0,0) to twod_array(1,0) and the other ones are blank. I suspect this has to do with how I used ReDim
e.g. right now I'm only getting:
twod_array(0,0) = 1
twod_array(1,0) = 4
but not:
twod_array(0,1) = 1
twod_array(1,1) = 5
instead I get:
twod_array(0,1) = //blank
twod_array(1,1) = //blank
Can someone please help me understand why my code is not resizing the 2D array correctly so I can output all elements it collects?
maybe you're after this:
Option Explicit
Sub arrays()
Dim arrayOne As Variant, arrayTwo As Variant
arrayOne = Array(1, 2, 3)
arrayTwo = Array(4, 5, 6)
Dim i As Long
ReDim twod_array(1, UBound(arrayOne)) As Variant ' array sizing
For i = 0 To UBound(arrayOne)
twod_array(0, i) = arrayOne(i)
twod_array(1, i) = arrayTwo(i)
Next
End Sub
which outputs your desired output:
twod_array(0,0) = 1
twod_array(1,0) = 4
and
twod_array(0,1) = 2
twod_array(1,1) = 5
For example, I have numbers 1,9,7,4 and I want to randomize their position so I will get 9,1,4,7 or 7,1,9,4 etc. Do you know how? Thanks
Here is a basic vba randomize into a dictionary object.
Dim vals As Variant, ord As Object
Set ord = CreateObject("scripting.dictionary")
vals = Array(1, 4, 7, 9)
Do While ord.Count < (UBound(vals) + 1)
ord.Item(vals(Application.RandBetween(LBound(vals), UBound(vals)))) = vbNullString
Loop
Debug.Print Join(ord.keys, ", ")
Here's a more likely (simplistic) example: (I hope I didn't do your homework for you)
Sub sub1()
Dim i1&, i2&, iswap&, a4 As Variant
a4 = Array(1, 9, 7, 4)
For i1 = 0 To 3
i2 = Int(Rnd() * 4) ' random integer 0 to 3
iswap = a4(i1) ' swap(a4(i1), a4(i2))
a4(i1) = a4(i2)
a4(i2) = iswap
Next i1
Debug.Print a4(0); a4(1); a4(2); a4(3) ' Ctl-G to view, F7 to get back to code
End Sub
You didn't specify the basic dialect so here is some code:
a(1) = 1 : a(2) = 4 : a(3) = 7 : a(4) = 9
FOR l = 1 TO 4
SWAP a(l), a(INT(RND * 4 + 1))
NEXT
END
I have of integers in Col A and in col B i want to show result 'Prime' if it doesn't have further factors for the number itself. This goes like this if the number for example is 37 result will be 'Prime' and if its 44 then result will be 2x2x11. How can i do this using excel formula? Screen shot :
Disclaimer: code below is ported from this very useful VB.NET example
Option Explicit
Sub Test()
Debug.Print FindFactors(2)
Debug.Print FindFactors(3)
Debug.Print FindFactors(11)
Debug.Print FindFactors(12)
Debug.Print FindFactors(13)
Debug.Print FindFactors(16)
Debug.Print FindFactors(17)
Debug.Print FindFactors(24)
Debug.Print FindFactors(25)
Debug.Print FindFactors(11234)
Debug.Print FindFactors(67894)
End Sub
Function FindFactors(lngNumber As Long) As String
Dim collFactors As Collection
Dim lngFactor As Long
Dim lngCounter As Long
Dim strFactors As String
Dim strFactor As String
Set collFactors = New Collection
' Take out the 2s.
Do While (lngNumber Mod 2 = 0)
collFactors.Add 2
lngNumber = lngNumber / 2
Loop
' Take out other primes.
lngFactor = 3
Do While (lngFactor * lngFactor <= lngNumber)
If (lngNumber Mod lngFactor = 0) Then
' This is a factor.
collFactors.Add lngFactor
lngNumber = lngNumber / lngFactor
Else
' Go to the next odd number.
lngFactor = lngFactor + 2
End If
Loop
' If num is not 1, then whatever is left is prime.
If lngNumber > 1 Then
collFactors.Add lngNumber
End If
' make a string out of collection
strFactors = ""
If collFactors.Count = 1 Then
strFactors = "Prime"
Else
For lngCounter = 1 To collFactors.Count
strFactors = strFactors & collFactors(lngCounter)
If lngCounter < collFactors.Count Then
strFactors = strFactors & "x"
End If
Next lngCounter
End If
FindFactors = strFactors
End Function
Gives an output of:
Prime
Prime
Prime
2x2x3
Prime
2x2x2x2
Prime
2x2x2x3
5x5
2x41x137
2x83x409
Can be used in a worksheet:
Here is a somewhat straightforward recursive version. It is based on the idea that once you identify a factor you divide the number by that factor and then turn your attention to factoring the rest.
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "x" & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
Output:
Using LET and dynamic arrays allows for the following without VBA.
=LET(x, SEQUENCE(A1),
factors, FILTER(x, MOD(A1,x) = 0),
factorMatrix, 1 * (MOD(factors, TRANSPOSE(factors)) = 0),
primeFactors, FILTER(factors, MMULT(factorMatrix, factors ^ 0) = 2),
primeFactorList, IF(MOD(A1, primeFactors ^ SEQUENCE(1, 20)) = 0, primeFactors, ""),
factorProduct, TEXTJOIN("x",, primeFactorList),
IF(A1 = 1, "Neither", IF(factorProduct=A1&"","Prime",factorProduct)))
It works for numbers up to 2^20.
A slight modification to the excellent code of John Coleman above, using Mod with Doubles included below, will allow factoring integers up to Excel's 15 digit limit. Numbers with large factors may be noticeably slower. For example, 562,951,983,465,953 factored correctly as 16,777,259 x 33,554,467 in about 5 seconds on a Core i3.
Function Factor(ByVal n As Double, Optional FirstTrial As Double = 2) As String 'Changed
Dim i As Long
Dim t As Double 'Changed
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If FMod(t, n) = 0 Then 'Changed
.
.
.
Public Function FMod(a As Double, b As Double) As Double
FMod = a - Fix(a / b) * b
'http://en.wikipedia.org/wiki/Machine_epsilon
'Unfortunately, this function can only be accurate when `a / b` is outside [-2.22E-16,+2.22E-16]
'Without this correction, FMod(.66, .06) = 5.55111512312578E-17 when it should be 0
If FMod >= -2 ^ -52 And FMod <= 2 ^ -52 Then '+/- 2.22E-16
FMod = 0
End If
End Function
I'm currently working on a small piece of vba software that is doing some excel worksheet manipulation. I'm currently running into an indexOutOfRangeException during the first iteration of the loop in the code below. I've run this in debug and can see that the array has a value at the requested index but I keep getting this exception.
Private Sub AddReportQuestions(ByRef ReportName As String, ByRef i As Integer,
ByRef domainStart As Integer, ByRef domainEnd As Integer,
ByRef xlReportWorkSheet As Excel.Worksheet,
ByRef xlQuestionWorkSheet As Excel.Worksheet)
Dim row As Integer
row = 0
Dim maxPrintableRow = ((domainEnd - domainStart) * 4) + 7
Dim maxQuestions = (domainEnd - domainStart) + 1
Dim reportRange = xlReportWorkSheet.Range(xlReportWorkSheet.Cells(7, (i * 10) + 1), xlReportWorkSheet.Cells(maxPrintableRow, (i * 10) + 10))
Dim questionRange = xlQuestionWorkSheet.Range("C" & domainStart & ":I" & domainEnd)
Dim questionArray(maxQuestions, 7) As Object
Dim reportArray(maxPrintableRow + 1, 10) As Object
questionArray = questionRange.Value
For j = 0 To maxQuestions
' Question
reportArray(row, 0) = questionArray(j, 0)
' Resize Row Height
xlReportWorkSheet.Rows(row + 7).RowHeight = 45
row += 1
' Response and Comment
reportArray(row, 0) = questionArray(j, 1)
reportArray(row, 2) = questionArray(j, 4)
' Resize Row Height
xlReportWorkSheet.Rows(row + 7).RowHeight = 45
row += 1
' Likelihood and Consequence
reportArray(row, 0) = "Likelihood:"
reportArray(row, 2) = questionArray(j, 2)
reportArray(row, 4) = "Consequence:"
reportArray(row, 6) = questionArray(j, 3)
row += 1
' Divider line
reportArray(row, 0) = "________________________________________________________________________________________________________________________"
row += 1
Next
reportRange.Value = reportArray
End Sub
questionArray is the offender in this code.
You are declaring questionArray and reportArray as objects, however you are treating them like variables. Change your declaration statements to
Dim questionArray as variant
Dim reportArray(maxPrintableRow + 1, 10) As String