Найти максимальный элемент двумерного массива - VBA

Узнай цену своей работы

Формулировка задачи:

Написать функцию или процедуру, осуществляющую заданные вычисления, Нужно найти максимальный элемент двумерного массива и его индексы. Желательно через процедуру, и размер не меньше 16 элементов ( например В (4,4) )

Решение задачи: «Найти максимальный элемент двумерного массива»

textual
Листинг программы
Sub mMAX()
Dim i&, j&, nR&, nC&, arrNEW(), currCell As Range
Dim mFlag As Boolean
' Раз нужно последний max - значит будет последний!
'----------------------------------
    Call CreateARRAY
'===========================
    With ActiveSheet
        arrNEW = .Cells(1, 1).CurrentRegion.Value
            For i = UBound(arrNEW, 1) To LBound(arrNEW, 1) Step -1
                For j = UBound(arrNEW, 2) To LBound(arrNEW, 2) Step -1
                    If arrNEW(i, j) = Application.Max(arrNEW) Then
                        mFlag = True
                        Exit For
                    End If
                Next 'j
                If mFlag = True Then Exit For
            Next 'i
'сообщаем:
        MsgBox "MAXVALUE is" & Space(3) & Application.Max(arrNEW) & _
                    Chr(13) & String(20, "-") & Chr(13) & _
                    "This value lies in:" & Chr(13) & _
                    Space(12) & "Row " & i & ";" & Space(3) & "Column " & j & "."
 'И на лист:
            With .Cells(Rows.Count, 1).End(xlUp)
                .Offset(2, 0).Value = "MAXVALUE is"
                .Offset(2, 2).Value = Application.Max(arrNEW)
                .Offset(4, 0).Value = "This value lies in:"
                .Offset(4, 2).Value = "Row " & i
                .Offset(5, 2).Value = "Column " & j
            End With
        Union(.Rows(i), .Columns(j)).Select: .Cells(i, j).Activate
    End With
    MsgBox Space(12) & "D O N E!"
End Sub
 
Sub CreateARRAY()
Dim nR&, nC&, mARR(), currCell As Range
Dim mFlag As Boolean
    nR = 20: nC = 10: ReDim mARR(1 To nR, 1 To nC)
    With ActiveSheet
        .Cells(1, 1).Select
        .Cells.ClearContents
        Randomize
            For Each currCell In Range(.Cells(1, 1), .Cells(nR, nC))
                mARR(currCell.Row, currCell.Column) = _
                            Int((777 - (-555) + 1) * Rnd) + (-555)
            Next
        .Cells(1, 1).Resize(UBound(mARR, 1), _
                                UBound(mARR, 2)).Value = mARR
    End With
End Sub

Оцени полезность:

5   голосов , оценка 4.6 из 5
Похожие ответы