VBA从multidementional阵列

Question

得到最小/最大我有以下示例代码：

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 

在实际代码的vararray将可能是6或7维与具有多达1000个值中的每个尺寸。这意味着循环会花费很多时间，我想限制这些时间。

有没有办法让最后两个循环段（找到最大值和获取索引）更快？ （例如WorsheetFunction.Max（），但是这仅适用于最大2维）

在此先感谢！

Answer 1

您可能避免两个循环通过“分配价值”循环检查值和位置：

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 

Answer 2

我不认为有任何方式，以避免循环，虽然它可能是一个编译库函数可能为许多（大）尺寸提供了一些改进。但是这是一个（或更多）数量级的难度，可能不会尝试，除非有迫切的需求。

我存储i值，每次我找到一个新的最大j & k：

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) 

Answer 3

非常interesing问题。

我尝试检查性能，但我没有发现什么快得多。梅比，这对你有用。

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 

你几乎不做修改子：

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使用数组的数组（我有希望，这将是最快的，但不是:(）：

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 

而去年使用每个，快一点：

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 

结果：

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