在VBA中查找多維數組中最小值的索引

Question

在下面的代碼中，我有一個n x n x n數組值。我需要確定包含最小值，第二到最小值，第三到最小值......的索引，並將它們放入它們自己的數組中，以便稍後在代碼中使用。 CC目前定義爲11 x 11 x 11陣列，我需要確定最小值。下面是包含這些值的我的數組CC的設置。 n被定義爲數組h2s的長度，在這種情況下碰巧是11。 h2st是h2s中的值的總和。

h2s = [1.099, 0.988, 0.7, 0.8, 0.5, 0.432, 0.8, 1.12, 0.93, 0.77, 0.658] 
h2st = 0 
n = Ubound(h2s) - Lbound(h2s) + 1 

For i = 1 to n 
    h2st = h2st + h2s(i) 
Next i 

For i = 1 To n 
    For j = i + 1 To n 
     For k = j + 1 To n 
      CC(i, j, k) = Abs(h2st - ((h2s(i) + h2s(j) + h2s(k)) * (n/3))) 
     Next k 
    Next j 
Next i 

Answer 1

您可以使用此函數，它接受一個多維數組並返回其n個最小值的數組，其中n是一個參數。重要的是，返回數組中的元素是一個數據結構Type Point，包含每個找到的點的座標和值。

您可以輕鬆地調整它找到N MAX值，僅僅通過在代碼改變兩個字符，如在評論中指出（初始化和比較）

Option Explicit 

Type Point 
    X As Long 
    Y As Long 
    Z As Long 
    value As Double 
End Type 

Function minVals(ar() As Double, nVals As Long) As Point() 
    Dim i As Long, j As Long, k As Long, m As Long, n As Long, pt As Point 

    'Initialize returned array with max values. 
    pt.value = 9999999# ' <-------- change to -9999999# for finding max 
    ReDim ret(1 To nVals) As Point 
    For i = LBound(ret) To UBound(ret): ret(i) = pt: Next 

    For i = LBound(ar, 1) To UBound(ar, 1) 
    For j = LBound(ar, 2) To UBound(ar, 2) 
     For k = LBound(ar, 3) To UBound(ar, 3) 

     ' Find first element greater than this value in the return array 
     For m = LBound(ret) To UBound(ret) 
      If ar(i, j, k) < ret(m).value Then ' <------- change to > for finding max 
      ' shift the elements on this position and insert the current value 
      For n = UBound(ret) To m + 1 Step -1: ret(n) = ret(n - 1): Next n 
      pt.X = i: pt.Y = j: pt.Z = k: pt.value = ar(i, j, k) 
      ret(m) = pt 
      Exit For 
      End If 
     Next m 
     Next k 
    Next j 
    Next i 
    minVals = ret 
End Function 

---

Sub Test() 
    Dim i As Long, j As Long, k As Long, pt As Point 
    Const n As Long = 11 

    ReDim CC(1 To n, 1 To n, 1 To n) As Double 
    For i = 1 To n 
    For j = 1 To n 
     For k = 1 To n 
     CC(i, j, k) = Application.RandBetween(100, 100000) 
     Next k 
    Next j 
    Next i 

    ' Testing the function: get the smalles 5 values and their coordinates 
    Dim mins() As Point: mins = minVals(CC, 5) 

    ' Printing the results 
    For i = LBound(mins) To UBound(mins) 
    Debug.Print mins(i).value, mins(i).X, mins(i).Y, mins(i).Z 
    Next 
End Sub