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 values ，只需更改代码中的两个字符，如注释（初始化和比较）中所示

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

在VBA

1 个答案: