PDA

View Full Version : Solved: find max in multi dimensional array



amateur1902
04-10-2008, 03:27 AM
Hello everyone,

what i would like to know is how can i find the max in a multidimensional array. I would like to search in vba and only the outcome has to be put in excell.

I use the following array.

i,0,0,1

i is a variable and place where i should find the max.

I really have no idea what i should do to make this work.

Thanks

Amateur

tstav
04-10-2008, 04:52 AM
This is for a 0-based variant array. The 'place' where we should find the max is supposed to be of type integer. You may change some things as they suit you.
Sub FindMaxInMultiDimArray()
Dim mult(0 to x, 0 to 0, 0 to 0, 0 to 1) as variant 'supply the x. It is the highest first dimension
Dim max As Integer, arr() As Integer
Dim i As Long, j As Byte, k As Long
For i = 0 To UBound(mult,1)
For j = 0 To 1
If k = 0 Then
ReDim arr(0 To k)
Else
ReDim Preserve arr(0 To k)
End If
arr(k) = mult(i, 0, 0, j)
k = k + 1
Next 'j
Next 'i
max = WorksheetFunction.Max(arr)

Range("A1").value = max
End Sub

tstav
04-10-2008, 05:15 AM
Interpreting your OP differently, I might skip the For j loop.
Sub FindMaxInMultiDimArray()
Dim mult(0 To x, 0 To 0, 0 To 0, 0 To 1) As Variant 'supply the x. It is the highest first dimension
Dim max As Integer, arr() As Integer
Dim i As Long, k As Long
For i = 0 To UBound(mult, 1)
If k = 0 Then
ReDim arr(0 To k)
Else
ReDim Preserve arr(0 To k)
End If
arr(k) = mult(i, 0, 0, 1)
k = k + 1
Next 'i
max = WorksheetFunction.max(arr)

Range("A1").Value = max
End Sub

amateur1902
04-10-2008, 05:20 AM
hi tstav,

again thanks for youre help. i am comming close with getting it right.
Except that i don't seem to get the array that i want in the proces.

The array that i have is the following:

vtresult(i, a, 0, 1)

In i i want to find the max and when i have found it i want to go to next array a. Then it starts all over again.

So when i've got 5 kind of rows in a. then i want to find the max for every row.

I hope it is clear.

Thanks

Amateur

amateur1902
04-10-2008, 07:11 AM
What am i doing wrong here? I tried in many ways to resolve my problem but i keep getting errors. For example expected expression for k. Why is that. Folowing i've got the whole code. But the problem you can find at max.(at the end of the code.)

If you have questions feel free to ask. I hope there is someone who can help me.


Private Sub CommandButton1_Click()

'Start timer
sngStart = Timer

'Script weergave uit (niet zichtbaar voor gebruiker)
Application.ScreenUpdating = False

Dim objDataControl As BLP_DATA_CTRLLib.BlpData
Set objDataControl = New BlpData

BStart = Range("F13").Value

BEnd = Range("F14").Value

' Set up the securities/fields in an array
arrayFields = Array("LAST_PRICE")

lka = Range("B26")
If IsEmpty(lka) Then
nr_comp = 1
Else
nr_comp = Range(Range("B27"), Range("B27").End(xlDown)).Rows.Count
End If

'Bepaald grote van array
Dim arraySecurities() As String
ReDim arraySecurities(nr_comp)
'Leading Fund
Range("B1") = Range("B26").Value

Range("B1").Replace What:="Equity", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("B1").Replace What:="equity", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("B1").Replace What:="EQUITY", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

tiu = Range("B1").Value
tiu = tiu & " equity"
arraySecurities(0) = tiu

'Peers (per peer wordt data binnen gehaald)
With Range("B27")
i = 1
Do While i <= nr_comp
arraySecurities(i) = .Cells(i, 1).Value
i = i + 1
Loop
End With

'D/M/Y
objDataControl.GetHistoricalData arraySecurities, 1, "Last Price", _
CDate(BStart), _
CDate(BEnd), _
BarSize:=1, _
BarFields:=arrayFields, _
Results:=vtresult


'TimeLag
Dim iDavid() As String
ReDim iDavid(nr_comp)

a = 0
Do While a < nr_comp + 1
base = vtresult(0, a, 0, 1) * 1.005
i = 0
Do While vtresult(i, a, 0, 1) <= base
t = vtresult(i, a, 0, 1)

If (i <= 15) Then
iGo = i
Else
iGo = 3333
Exit Do
End If
i = i + 1


Loop

iDavid(a) = iGo
a = a + 1
Loop
Dim FindMaxInMultiDimArray()

k = 0
z = 0

Dim vtresult(k, z, 0, 1) As Variant 'supply the x. It is the highest first dimension
Dim max As Integer, arr() As Integer
Dim g As Long, j As Byte, k As Long
For k = 0 To UBound(mult, 1)
For a = 0 To 1
If k = 0 Then
ReDim arr(0 To k)
Else
ReDim Preserve arr(0 To k)
End If
arr(k) = vtresult(i, z, 0, 1)
k = k + 1
Next 'j
z = z + 1
Next 'i
max = WorksheetFunction.max(arr)



For k = 0 To nr_comp
Range("A1").Offset(k, 0).Value = max
Next k

For k = 0 To nr_comp
Range("D26").Offset(k, 0).Value = iDavid(k)
Next k

'### Stop Timer
sngEnd = Timer
sngElapsed = Format(sngEnd - sngStart, "Fixed")

'Tijdsmelding aantal seconden proces snelheid
Range("F8").Value = sngElapsed & " seconden"

Application.CutCopyMode = False
Range("A1").Select

Application.Calculation = xlAutomatic

End Sub

tstav
04-10-2008, 07:17 AM
The array that i have is the following:
vtresult(i, a, 0, 1)
In i i want to find the max and when i have found it i want to go to next array a. Then it starts all over again.
So when i've got 5 kind of rows in a. then i want to find the max for every row.
I hope it is clear

Not clear to me, amateur. I hope it is to someone else.

amateur1902
04-10-2008, 07:29 AM
ill try to make it clear.

I've got a array, In this array there are multiple rows with figures.

From each row i want to find the max and put them in excell.

So when i've got 10 rows of figures in the array, then i want 10x max.

This is the array that i've got.

vtresult(i, a, 0, 1)

When i want to find max in 1 of the rows then i have to search trough i. so i believe this will look like this at the end of a loop i = 1 + i.

When i have found de max of the first row then i want to find it of the second row. To go to the second row i have to raise a. so a = a + 1. When i raise a with one then i'll get a new row with figures. Then from this row i want to find the max. and so on.

i think this will make it clear to you all.