Найти максимальный элемент двумерного массива - 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