3

I have the following example code:

Public Sub max_in_array()

Dim vararray(10, 10, 10) As Double

'Assign values to array
For i = 1 To 10
 For j = 1 To 10
  For k = 1 To 10
  vararray(i, j, k) = i * j * k 'This will be more complicated in the actual code
  Next k
 Next j
Next i

'Find the maximum
Dim intmax As Double
intmax = 0
For i = 1 To 10
 For j = 1 To 10
  For k = 1 To 10
   If vararray(i, j, k) > intmax Then
    Intmax = vararray(i, j, k)
   End If
  Next k
 Next j
Next i

MsgBox "max = " & CStr(intmax)

'Find maximum position
For i = 1 To 10
 For j = 1 To 10
  For k = 1 To 10
   If vararray(i, j, k) = intmax Then
    MsgBox "Maximum indices are " & CStr(i) & " " & CStr(j) & " " & CStr(k)
   End If
  Next k
 Next j
Next i

End Sub

In the actual code the vararray will probably be 6 or 7 dimensional with each dimension having up to 1000 values. That means the loops will take a lot of time, which I want to limit.

Is there a way to make the last two loop segments (finding the maximum and getting the indexes) faster? (E.g. WorsheetFunction.Max(), but this only works on maximum 2 dimensions)

Improve this question

3 Answers 3

Reset to default
2

You may avoid two loops checking values and position through the "assign value" loop:

Public Sub max_in_array()

Dim vararray(10, 10, 10) As Double
Dim Pos(1 To 3)

'Assign values to array
For i = 1 To 10
 For j = 1 To 10
  For k = 1 To 10
  vararray(i, j, k) = i * j * k 'This will be more complicated in the actual code
  If vararray(i, j, k) > Intmax Then
    Intmax = vararray(i, j, k)
    Pos(1) = i
    Pos(2) = j
    Pos(3) = k
  End If

  Next k
 Next j
Next i

MsgBox "Maximum indices are " & Join(Pos, " ")

End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

1

I don't think there's any way to avoid the loop, although it's possible that a compiled library function might offer some improvement for many (large) dimensions. But that's an order of magnitude (or more) harder and probably not to be attempted unless there's dire need.

I'd store the values of i, j & k each time I find a new maximum:

Dim intmax As Double, max_i As Integer, max_j As Integer, max_k As Integer
intmax = 0
max_i = -1, max_j = -1, max_k = -1
For i = 1 To 10
 For j = 1 To 10
  For k = 1 To 10
   If vararray(i, j, k) > intmax Then
    Intmax = vararray(i, j, k)
    max_i = i
    max_j = j
    max_k = k
   End If
  Next
 Next
Next

MsgBox "Maximum indices are " & CStr(max_i) & " " & CStr(max_j) & " " & CStr(max_k)
Improve this answer

Comments

1

Very interesing question.

I try check performance but i dont find nothing much faster. Mayby this will be useful for you.

Sub TestArrMaxMin()

NrOfLoops = 100
'1 test
Start = Timer
For i = 1 To NrOfLoops
max_in_array
Next i
Debug.Print Timer - Start & " max_in_array Loops=" & NrOfLoops
'2 test
Start = Timer
For i = 1 To NrOfLoops
max_in_array_of_array
Next i
Debug.Print Timer - Start & " max_in_array_of_array Loops=" & NrOfLoops
'3 test
Start = Timer
For i = 1 To NrOfLoops
max_in_array_each_in
Next i
Debug.Print Timer - Start & " max_in_array_each_in Loops=" & NrOfLoops

End Sub

Your sub with little modification:

Public Sub max_in_array()

Dim VarArray(100, 100, 100) As Double
'Assign values to array
For i = 0 To 100
 For j = 0 To 100
  For k = 0 To 100
  VarArray(i, j, k) = Rnd() 'This will be more complicated in the actual code
  Next k
 Next j
Next i

'Find the maximum
Dim IntMax As Double
IntMax = 0
For i = 0 To 100
 For j = 0 To 100
  For k = 0 To 100
   If VarArray(i, j, k) > IntMax Then
    IntMax = VarArray(i, j, k)
    IntMaxAdr = i & "," & j & "," & k
   End If
  Next k
 Next j
Next i
'Debug.Print "max = " & CStr(IntMax)
'Debug.Print "Maximum indices are " & IntMaxAdr

End Sub

Sub using Array of Arrays (I had hopes, that it will be fastest but not :( ):

Public Sub max_in_array_of_array()

Dim VarArray(100, 100) As Double

Dim ArrayOfArrays(100) As Variant
'Assign values to array

For i = 0 To 100
    For j = 0 To 100
        For k = 0 To 100
        VarArray(j, k) = Rnd() 'This will be more complicated in the actual code
        Next k
    Next j
ArrayOfArrays(i) = VarArray
Next i

'Find the maximum
Dim IntMax As Double
IntMax = 0
Dim IntMaxAdr As Integer
IntMaxAdr = 0

For i = 0 To 100
Max = Application.WorksheetFunction.Max(ArrayOfArrays(i))
   If Max > IntMax Then
    IntMax = ArrMember
    IntMaxAdr = i
   End If
Next i

'find addres
adr_i = IntMaxAdr

For j = 0 To 100
    For k = 0 To 100
        If IntMax = ArrayOfArrays(adr_i)(j, k) Then
        adr_j = j
        adr_k = k
        Exit For
        End If
    Next k
Next j

'Debug.Print "max = " & CStr(IntMax)
'Debug.Print "Maximum indices are " & adr_i & "," & adr_j & "," & adr_k

End Sub

And last using for each, little faster:

Public Sub max_in_array_each_in()

Dim VarArray(100, 100, 100) As Double
'Assign values to array
For i = 0 To 100
 For j = 0 To 100
  For k = 0 To 100
  VarArray(i, j, k) = Rnd() 'This will be more complicated in the actual code
  Next k
 Next j
Next i

'Find the maximum
Dim IntMax As Double
IntMax = 0
Dim ArrMemberIndex As Long
ArrMemberIndex = -1

For Each ArrMember In VarArray
ArrMemberIndex = ArrMemberIndex + 1
   If ArrMember > IntMax Then
    IntMax = ArrMember
    IntMaxAdr = ArrMemberIndex
   End If
Next

'calculate i,j,k
adr_i = IntMaxAdr Mod 101
adr_j = Int(IntMaxAdr / 101) Mod 101
adr_k = Int(IntMaxAdr / (101 ^ 2))

'Debug.Print "max = " & CStr(IntMax)
'Debug.Print "Maximum indices are " & adr_i & "," & adr_j & "," & adr_k

End Sub

Results:

TestArrMaxMin
25,67969 max_in_array Loops=100
31,46484 max_in_array_of_array Loops=100
21,24609 max_in_array_each_in Loops=100
Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.