在VBA中查找多维数组中最小值的索引 [英] Find the indices for the minimum values in a multi dimensional array in VBA

问题描述

在下面的代码中，我有一个n x n x n个数组。我需要识别包含最小值，秒到最小值，第三个到最小值的索引，并将它们放入自己的数组中，以便稍后在代码中使用。 CC目前被定义为11 x 11 x 11阵列，我需要确定最小值。下面是我的数组CC的设置，其中包含值。 n定义为阵列h2s的长度，在这种情况下恰好为11。 h2st是h2s中的值的总和。

In the code below I have an n x n x n array of values. I need to identify the indices that contain the minimum, second to minimum, third to minimum, ..., and put them into their own array to be used later on in the code. CC is currently defined as a 11 x 11 x 11 array and I need to identify the minimums. Below is the setup of my array CC that contains the values. n is defined as the length of the array h2s, which happens to be 11 in this case. h2st is the sum of the values in 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

推荐答案

您可以使用该函数接受多维数组，并返回其n个最小值的数组，其中n是一个参数。重要的是，返回数组中的元素是 Type Point 的数据结构，其中包含每个查找点的坐标和值。

You can use this function that takes a multidimensional array and returns an array of its n minimum values, where n is a parameter. Importantly, the elements in the returned array are a data structure of Type Point, containing the coordinates and the value of each found point.

只要改变代码中的两个字符（初始化和比较）

You can easily adjust it for finding the n max values, just by changing two characters in the code, as indicated in comments (the initialization and the comparison)

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中查找多维数组中最小值的索引的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！