I want to find the index of each of the four largest elements in an array.
Note: - What I need is position of the elements I don't need to sort them.
Loop through them and keep track of the four largest is the only way. I can't think of anything more efficient than an O(n) operation.
I think this would work. It will give you an array containing a variable number of largest indices:
Function GetLargestIndices(inArray() As Integer, numIndices As Integer) As Integer()
ReDim returnArray(numIndices) As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
For i = 0 To UBound(returnArray)
returnArray(i) = -1
Next
For i = 0 To UBound(inArray)
For j = UBound(returnArray) To 0 Step -1
If (returnArray(j) = -1) Then
returnArray(j) = i
Exit For
ElseIf (inArray(i) > inArray(returnArray(j))) Then
If (j > 0) Then
For k = 0 To j
returnArray(k) = returnArray(k + 1)
Next
End If
returnArray(j) = i
Exit For
End If
Next
Next
GetLargestIndices = returnArray
End Function
Here's a way to test it:
Sub Test()
Dim testArray(10) As Integer
testArray(0) = 125
testArray(1) = 6
testArray(2) = 45
testArray(3) = 15
testArray(4) = 16
testArray(5) = 107
testArray(6) = 108
testArray(7) = 10
testArray(8) = 32
testArray(9) = 45
testArray(10) = 72
Dim largestArray() As Integer
largestArray = GetLargestIndices(testArray, 4)
End Sub
Related
I am trying to create a function that finds the mean of the last d days from an array. My array is a time series with dates as col1 and prices as col2.
I want my function to be to allow the user to select the range, enter the number of days in past he wants the mean, and a Boolean whether the data is ascending or descending. if the number of elements in the series doesn't match d, example mean of 32 + "" then the function returns 0.
the Problem i am having is when i want to use the drag down in excel to fill the rest of the columns, the function doesn't work. for example for the sorted array; it takes mean of 56 + 34, then using drag down in excel the second cell should be the mean of 34 + 22 except it returns 0 and so on..
Function meanby(x As Range, d As Integer, sortarr As Boolean) As Double
Dim arr() As Variant
Dim i As Integer
Dim j As Integer
Dim count As Integer
Dim total As Double
Dim n As Integer
Dim temp As Variant
Dim arr2 As Variant
arr = rgntoarr(x)
n = x.Rows.count
If sortarr = False Then
For i = 1 To n / 2
temp = arr(i, 2)
arr(i, 2) = arr(n - i + 1, 2)
arr(n - i + 1, 2) = temp
Next i
End If
arr2 = arr
For j = 1 To d
total = total + arr2(j, 2)
If arr2(j, 2) = "" Then
Exit For
End If
i = i + 1
count = count + 1
Next j
If count < d Then
meanby = 0
Else
meanby = total / count
End If
End Function
I'm trying to find an index of the minimum value from sum(3) array. And it should be assigned to a variable min
min = index of minimum value
Should I sort the array first or is there any direct way of doing it?
Here is my code:
`Sub Min_index()
Dim Pt_array(3) As Single
Pt_array(0) = 0
Pt_array(1) = 12.3
Pt_array(2) = 16.06
Pt_array(3) = 20.11
Dim Ad_E_array(3) As Single
Dim Lo_E_array(3) As Single
Dim Bs_temp As Single
Dim i As Integer
i = 0
Do While i < 4
Bs_temp = BS
Ad_E_array(i) = Ad_E 'defined in previous Sub
Lo_E_array(i) = Lo_E 'defined in previous Sub
If Bs_temp + Pt_array(i) - Qth < BS_Maximum_limit Then
Bs_temp = Bs_temp + Pt_array(i) - Qth
Ad_E_array(i) = Ad_E_array(i) + 0
Lo_E_array(i) = Lo_E_array(i) + 0
Call function_decide(int_forecast_hour - 1, Bs_temp, Qth + 1, Lo_E_array(i), Ad_E_array(i))
Else
Lo_E_array(i) = Pt_array(i) - Qth - (BS_Maximum_limit - Bs_temp)
Bs_temp = BS_Maximum_limit
Call function_decide(int_forecast_hour - 1, Bs_temp, Qth + 1, Lo_E_array(i), Ad_E_array(i))
End If
i = i + 1
Loop
Dim sum(3) As Single
Dim min As Single
i = 0
Do While i < 4
sum(i) = Abs(Lo_E_array(i)) + Abs(Ad_E_array(i))
i = i + 1
Loop
End Sub`
You can receive the 1-based index position of the element containing the minimum value with the an Excel Application object's use of the worksheet's MIN function and MATCH function.
Sub wqewuiew()
Dim Pt_array(3) As Single, p As Long
Pt_array(0) = 1000
Pt_array(1) = 12.3
Pt_array(2) = 16.06
Pt_array(3) = 20.11
p = Application.Match(Application.Min(Pt_array), Pt_array, 0)
Debug.Print p '<~~ 'p' is 2 (I changed the value of the first array element)
End Sub
I have two functions in VBA. Function1 returns a 1D array. Then I have function2 which is a multidimensional array. I would like to copy the array in Function1 to the columns of the multidimensional array starting at index 1.
arr2(0,0) = "Something"
arr2(0,1) = ("Something",arr1(0))
arr2(0,2) = ("Something",arr1(1))
This is what I have. arr1 is GetRecData and arr2 is AllChannelsData.
For i = 0 To UBound(channelList)
'the first row in the array is the channels names
AllChannelsData(i, 0) = channelList(i)
Set RecChannel = Rec.FindChannel(channelList(i), RecDevice.Name)
For j = 0 To total_time
AllChannelsData(i, j + 1) = RecChannelData.GetRecData(RecChannel, 1, 0)
Next
Next
Thanks!
please refer the code below.
Sub Array_test()
Dim GetRecData(9) As String
Dim AllChannelsData(9, 2) As String
For i = 0 To 9
GetRecData(i) = i
For j = 0 To 9
AllChannelsData(j, 0) = j
AllChannelsData(j, 1) = GetRecData(j)
Next j
Next i
End Sub
Change this:
For j = 0 To total_time
AllChannelsData(i, j + 1) = RecChannelData.GetRecData(RecChannel, 1, 0)
Next
to this
For j = 0 To total_time
AllChannelsData(i, j + 1) = RecChannelData.GetRecData(RecChannel, 1, j)
Next
maybe?
I'm assuming the third parameter of the .GetRecData(RecChannel, 1, 0) method is the index since 1D arrays like you're describing don't take 3 parameters. If that's not it, you may need to expand on what the GetRecData method is/does/returns/etc.
this "base" code works
Option Explicit
Sub main()
Dim arr1 As Variant
Dim arr2() As Variant
Dim total_time As Integer, i As Integer, j As Integer
total_time = 4
ReDim arr2(0 To 3, 0 To total_time)
For i = 0 To 3
arr2(i, 0) = i
For j = 1 To total_time
arr2(i, j) = GetRecData(j + 1)
Next j
Next i
End Sub
Function GetRecData(n As Integer) As Variant
ReDim arr(0 To n - 1) As Variant
Dim i As Integer
For i = 1 To n
arr(i - 1) = i
Next i
GetRecData = arr
End Function
just adapt it to your needs
I am trying to have my code prompt the user to select a range of data of 3 width and variable length. There will only be 30 values those with some rows being blank. I want to have these 30 values populate into 30 text boxes in a userform of mine (this is so values don't have to be manually entered). I looked around and figured my route should be Application.Inputbox and then pass it into an array were the blank rows can be weeded out with for loops. I don't know how to pass the user selected table into a 2D array though.
Sub selectRange()
Dim r(1 To 14, 1 To 3) As Variant, ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set r = Application.InputBox("Select the Cal B table.", Type:=8)
For j = 1 To 14
For i = 1 To 3
If Abs(r(j, i)) > 0 Then
calB(l) = r(j, i)
l = l + 1
End If
Next
Next
lx = calB(1)
ly = calB(2)
lz = calB(3)
rx = calB(4)
ry = calB(5)
rz = calB(6)
ix = calB(7)
iy = calB(8)
iz = calB(9)
sx = calB(10)
sy = calB(11)
sz = calB(12)
p1x = calB(13)
p1y = calB(14)
p1z = calB(15)
p2x = calB(16)
p2y = calB(17)
p2z = calB(18)
lfx = calB(19)
lfy = calB(20)
lfz = calB(21)
lrx = calB(22)
lry = calB(23)
lrz = calB(24)
rfx = calB(25)
rfy = calB(26)
rfz = calB(27)
rrx = calB(28)
rry = calB(29)
rrz = calB(30)
ActiveWorkbook.Close
dozercall.Show
End Sub
Thanks in advance for everyone's help.
Edit: I missed that you were using the input box wrong, however I will leave this answer as it presents a way to collapse a variable range of user input from a multidimensional array into a single dimension array.
This should get you started. Basically it will read the user's input, dynamically create a one-dimensional array of the correct size (rows * columns), and read all the values in the range the user selects to this one dimensional array. It will then loop through the one dimensional array and print the values back out to the window.
I think this is what you're looking for, but if you need further clarification I can add some. I added comments so you can see what each section is doing.
Option Explicit
Private Sub TestArrays()
Dim calBTemp() As Variant, calB() As Variant
Dim i As Long, j As Long, x As Long
Dim rngInput As Range
Set rngInput = Application.InputBox("Select the Cal B table.", "Select Range", Type:=8)
'Read the user input, check for empty input
'If empty input, exit the subroutine
If Not rngInput Is Nothing Then
calBTemp = rngInput
Else
Exit Sub
End If
'Create the one-dimensional array dynamically based on user selection
ReDim calB((UBound(calBTemp, 1) - LBound(calBTemp, 1) + 1) * (UBound(calBTemp, 2) - LBound(calBTemp, 2) + 1))
'Loop through our multidimensional array
For i = LBound(calBTemp, 1) To UBound(calBTemp, 1)
For j = LBound(calBTemp, 2) To UBound(calBTemp, 2)
'Assign the value to our one dimensional array
calB(x) = calBTemp(i, j)
x = x + 1
Next j
Next i
'Loop through our one dimensional array
For i = LBound(calB) To UBound(calB)
Debug.Print calB(i)
Next i
End Sub
So I just wasn't using the Application.Inputbox right. If you return it as a range it will configure to the proper sized 2D array it seams and you can call/manipulate data from there. Here is a working sub.
Sub selectRange()
Dim ran As Range, calB(1 To 30) As Double, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set ran = Application.InputBox("Select the Cal B table.", Type:=8)
l = 1
For j = 1 To 14
For i = 1 To 3
If Abs(ran(j, i)) > 0 Then
calB(l) = ran(j, i)
l = l + 1
End If
Next
Next
lx = calB(1)
ly = calB(2)
lz = calB(3)
rx = calB(4)
ry = calB(5)
rz = calB(6)
ix = calB(7)
iy = calB(8)
iz = calB(9)
sx = calB(10)
sy = calB(11)
sz = calB(12)
p1x = calB(13)
p1y = calB(14)
p1z = calB(15)
p2x = calB(16)
p2y = calB(17)
p2z = calB(18)
lfx = calB(19)
lfy = calB(20)
lfz = calB(21)
lrx = calB(22)
lry = calB(23)
lrz = calB(24)
rfx = calB(25)
rfy = calB(26)
rfz = calB(27)
rrx = calB(28)
rry = calB(29)
rrz = calB(30)
ActiveWorkbook.Close
dozerCal.Show
End Sub
This code will do the trick (and forces the user to select 3 columns and 14 rows):
Sub selectRange()
Dim selectedRange As Range
Dim errorMessage As String
errorMessage = vbNullString
Dim ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
Do
'doesn't handle cancel event
Set selectedRange = Application.InputBox("Select the Cal B table.", _
Type:=8, Title:="Please select 14 rows and 3 columns" & errorMessage)
errorMessage = "; previous selection was invalid"
Loop While selectedRange.Columns.Count <> 3 Or selectedRange.Rows.Count <> 14
For j = 1 To 14
For i = 1 To 3
If Abs(selectedRange.Cells(j, i)) > 0 Then
calB(l) = selectedRange.Cells(j, i)
l = l + 1
End If
Next
Next
...rest of your code
I want to find the index of the nth largest value in an array. I can do the following but it runs into trouble when 2 values are equal.
fltArr(0)=31
fltArr(1)=15
fltArr(2)=31
fltArr(3)=52
For i = 0 To UBound(fltArr)
If fltArr(i) = Application.WorksheetFunction.Large(fltArr, n) Then
result = i
End If
Next
n=1 ---> 3
n=2 ---> 2 (but I want this to be 0)
n=3 ---> 2
n=4 ---> 1
Uses a second array to quickly get what you want without looping through each element for every value of n
Sub test()
Dim fltArr(0 To 3)
Dim X
Dim n As Long
Dim lngPos As Long
fltArr(0) = 31
fltArr(1) = 15
fltArr(2) = 31
fltArr(3) = 52
X = fltArr
For n = 1 To 4
lngPos = Application.WorksheetFunction.Match(Application.Large(X, n), X, 0) - 1
Debug.Print lngPos
X(lngPos) = Application.Max(X)
Next
End Sub
Edit:
Public Sub RunLarge()
Dim n%, i%, result%, count%
Dim fltArr(3) As Integer
Dim iLarge As Integer
fltArr(0) = 31:
fltArr(1) = 15:
fltArr(2) = 31:
fltArr(3) = 52
n = 1
Debug.Print " n", "iLarge", "result"
While n <= 4
count% = n - 1
iLarge = Application.WorksheetFunction.Large(fltArr, n)
For i = 0 To UBound(fltArr)
If fltArr(i) = iLarge Then
result = i
count% = count% - 1
If count% <= 0 Then Exit For
End If
Next
Debug.Print n, iLarge, result
n = n + 1
Wend
End Sub
result:
n iLarge result
1 52 3
2 31 0
3 31 2
4 15 1
It's a bit "dirty" but seeing as you're in Excel...
' Create a sheet with codename wsTemp...
For i = 0 To UBound(fltArr)
wsTemp.cells(i,1) = i
wsTemp.cells(i,2) = fltArr(i)
Next
with wsTemp
.range(.cells(1,1),.cells(i,2)).sort(wsTemp.cells(1,2),xlDescending)
end with
Result = wsTemp.cells(n,1)
Then you could also expand the sort to "sort by value then by index" if you wanted to control the "which of two equal 2nds should i choose" thing...
Perhaps this:
Public Sub RunLarge()
Dim fltArr() As Variant, X As Long
fltArr = Array(31, 15, 31, 52) 'Create the array
For X = 1 To 4 'Loop the number of large values you want to index
For i = LBound(fltArr) To UBound(fltArr) 'Loop the array
If fltArr(i) = Application.WorksheetFunction.Large(fltArr, 1) Then 'Find first instance of largest value
result = i
fltArr(i) = -9999 'Change the value in the array to -9999
Exit For
End If
Next
Debug.Print result
Next
End Sub
As it finds the first instance of the large number it replaces it with -9999 so on the next sweep it will pick the next instance of it.
Here's code for finding the nth largest item in collection. All you need to do is to write a function that would return it's index.
Sub testColl()
Dim tempColl As Collection
Set tempColl = New Collection
tempColl.Add 57
tempColl.Add 10
tempColl.Add 15
tempColl.Add 100
tempColl.Add 8
Debug.Print largestNumber(tempColl, 2) 'prints 57
End Sub
and the function itself, the easiest I could come up with.
Function largestNumber(inputColl As Collection, indexMax As Long)
Dim element As Variant
Dim result As Double
result = 0
Dim i As Long
Dim previousMax As Double
For i = 1 To indexMax
For Each element In inputColl
If i > 1 And element > result And element < previousMax Then
result = element
ElseIf i = 1 And element > result Then
result = element
End If
Next
previousMax = result
result = 0
Next
largestNumber = previousMax
End Function