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