如何引用VBA Max或Ubound函數的數組地址？

Question

如何引用WorksheetFunction.Max在數組中找到最大值的數組地址？陣列中可能有多個高點。

Dim myArraySum(1 to 4) as long 
Dim myArrayAddress(1 to 4) as integer 

myArraySum(1) = 2 
myArraySum(2) = 5 
myArraySum(3) = 7 
myArraySum(4) = 7 

      myArrayHigh = Application.WorksheetFunction.Max(myArraySum) 
      myArrayAddress = 'code needed 

我的期望的輸出是

myArrayHigh = 7 
myArrayAddress(1) = 3 
myArrayAddress(2) = 4 

Answer 1

最直截了當的方法是使用一個循環來檢查每一個數組元素的值。

Function GetMaxIndicesArray(ByRef myArraySum() As Long, ByRef myArrayAddress() As Integer) As Integer 
    Dim i As Integer, j As Integer, iLow As Integer, iUp As Integer 
    Dim lMax As Long 

    iLow = LBound(myArraySum) 
    iUp = UBound(myArraySum) 

    lMax = Application.WorksheetFunction.Max(myArraySum) 
    j = 1 

    For i = iLow To iUp 
    If (myArraySum(i) = lMax) Then 
     myArrayAddress(j) = i 
     j = j + 1 
    End If 
    Next 

    GetMaxIndicesArray = j - 1 
End Function 

Sub test() 
    Dim myArraySum(1 To 4) As Long 
    Dim myArrayAddress(1 To 4) As Integer 

    Dim i As Integer, n As Integer 

    myArraySum(1) = 2 
    myArraySum(2) = 5 
    myArraySum(3) = 7 
    myArraySum(4) = 7 

    myArrayHigh = Application.WorksheetFunction.Max(myArraySum) 
    'myArrayAddress = "" 'code needed 

    n = GetMaxIndicesArray(myArraySum, myArrayAddress) 

    Debug.Print "myArrayHigh = " & myArrayHigh 
    For i = 1 To n 
    Debug.Print "myArrayAddress(" & i & ") = " & myArrayAddress(i) 
    Next 

End Sub 

然後在你調試程序窗口，只需鍵入

test 

結果是這樣的：

myArrayHigh = 7 
myArrayAddress(1) = 3 
myArrayAddress(2) = 4 

Answer 2

使用一個簡單的循環：

Sub dural() 
    Dim myArraySum(1 To 4) As Long 
    Dim myArrayAddress(1 To 4) As Integer 
    Dim myArrayHigh As Long, k As Long, msg As String 

    myArraySum(1) = 2 
    myArraySum(2) = 5 
    myArraySum(3) = 7 
    myArraySum(4) = 7 

    myArrayHigh = Application.WorksheetFunction.Max(myArraySum) 

    k = 1 
    For i = LBound(myArraySum) To UBound(myArraySum) 
     If myArraySum(i) = myArrayHigh Then 
     myArrayAddress(k) = i 
     k = k + 1 
     End If 
    Next i 

    msg = "" 
    For i = LBound(myArrayAddress) To UBound(myArrayAddress) 
     msg = msg & vbCrLf & i & vbTab & myArrayAddress(i) 
    Next i 

    MsgBox msg 
End Sub