По максимальной цене вывести название детали, у которой эта максимальная стоимость

Sub Процедура1()
Dim Низ As Long
Dim Лист As Excel.Worksheet
Dim Массив() As String
Dim Max As Double
Dim Ячейка As Excel.Range
Dim i As Long
'С листами удобнее работать через переменные
'(удобно обращаться и кода меньше писать).
Set Лист = ActiveWorkbook.ActiveSheet
'Определение последней заполненной ячейки в столбце А
'(чтобы знать, где вставлять максимальные цены).
Низ = Лист.Cells(Лист.Rows.Count, 1).End(xlUp).Row
'Просматриваем ячейки в столбце B до последней
'заполненной и ищем максимальную цену.
'Максимальные значения будем помещать в массив,
'т.к. максимальная цена может быть одинаковой
'у нескольких деталей. За максимальную цену
'возьмём цену в первой ячейке столбца B, где указана цена.
Max = Лист.Cells(2, 2).Value
ReDim Массив(1 To 2, 1 To 1)
Массив(1, 1) = Лист.Cells(2, 1).Text
Массив(2, 1) = Лист.Cells(2, 2).Text
For Each Ячейка In Лист.Range(Лист.Cells(3, 2), Лист.Cells(Низ, 2)).Cells
    If Ячейка.Value > Max Then
        ReDim Массив(1 To 2, 1 To 1)
        Массив(1, 1) = Ячейка.Offset(0, -1).Text
        Массив(2, 1) = Ячейка.Text
    ElseIf Ячейка.Value = Max Then
        ReDim Preserve Массив(1 To 2, 1 To UBound(Массив, 2) + 1)
        Массив(1, UBound(Массив, 2)) = Ячейка.Offset(0, -1).Text
        Массив(2, UBound(Массив, 2)) = Ячейка.Text
    End If
Next Ячейка
'Выводим результат в конце наших данных.
Низ = Низ + 2
For i = 1 To UBound(Массив, 2)
    Лист.Cells(Низ + i, 1).Value = Массив(1, i)
    Лист.Cells(Низ + i, 2).Value = Массив(2, i)
Next i
'Сообщение, что всё готово.
MsgBox "Работа выполнена", vbInformation
End Sub

Sub n()
 max_st_det = Application.WorksheetFunction.Max([b2:b11])
 Cells(12, 1) = "макс.стоимость=" & max_st_det
 For Each cel In [b2:b11]
   If cel.Value = max_st_det Then nazw = Cells(cel.Row, 1)
 Next cel
 Cells(13, 1) = "название детали=" & nazw
End Sub

If cel.Value = max_st_det Then nazw = nazw & "; " & Cells(cel.Row, 1)

Sub kr_Click()
'объявляем переменные используемые в программе
Dim i As Long, j As Long 'счетчики циклов
Dim koll(15, 5) As Integer ' количество деталей каждого вида за каждый рабочий день
Dim zar(6) As Double 'заработок за каждый день
Dim koll_n(15) As Integer 'количество деталей каждого вида за истекший период
Dim cena(15) As Double 'стоимость одной изготовленной детали
Dim max_st_det As Double
Dim cel As Excel.Range
Dim nazw As String
 
'считываем начальные данные
Sheets("Нач_д").Activate
'в каждую ячейку массива cena(i) записывается стоимость каждой детали
'для этого используем цикл
For i = 1 To 15
cena(i) = Cells(3 + i, 2)
Next
 
'в каждую ячейку массива koll(i, j) записывается количество
'деталей каждого вида, изготовленных в день
'так как массив двумерный цикл проходит по двум счетчикам
For i = 1 To 15
For j = 1 To 5
koll(i, j) = Cells(3 + i, 2 + j)
         Next j
Next i
 
'на листе "Результат" создаются ячейки с определенными названиями
Sheets("Результат").Cells(1, 1) = "Количество изготовленных деталей"
Sheets("Результат").Cells(2, 1) = "Наименование изделия"
Sheets("Результат").Cells(2, 2) = "Стоимость 1 шт."
Sheets("Результат").Cells(2, 3) = "Изготовлено"
Sheets("Результат").Cells(3, 3) = "1-й день"
Sheets("Результат").Cells(3, 4) = "2-й день"
Sheets("Результат").Cells(3, 5) = "3-й день"
Sheets("Результат").Cells(3, 6) = "4-й день"
Sheets("Результат").Cells(3, 7) = "5-й день"
Sheets("Результат").Cells(3, 8) = "Всего"
Sheets("Результат").Cells(4, 1) = "болт"
Sheets("Результат").Cells(5, 1) = "винт"
Sheets("Результат").Cells(6, 1) = "гайка"
Sheets("Результат").Cells(7, 1) = "шайба"
Sheets("Результат").Cells(8, 1) = "шуруп"
Sheets("Результат").Cells(9, 1) = "гвоздь"
Sheets("Результат").Cells(10, 1) = "скрепка"
Sheets("Результат").Cells(11, 1) = "сверло"
Sheets("Результат").Cells(12, 1) = "шпилька"
Sheets("Результат").Cells(13, 1) = "дюпель"
Sheets("Результат").Cells(14, 1) = "шкант"
Sheets("Результат").Cells(15, 1) = "саморез"
Sheets("Результат").Cells(16, 1) = "зубчатое колесо"
Sheets("Результат").Cells(17, 1) = "крюк"
Sheets("Результат").Cells(18, 1) = "швеллер"
 
'в соответсвующие ячейки записываются цены каждой изготовленной детали
For i = 1 To 15
Sheets("Результат").Cells(3 + i, 2) = cena(i)
Next i
 
'в соответсвующие ячейки записываются количество
'деталей изготовленных за каждый день
For i = 1 To 15
For j = 1 To 5
    Sheets("Результат").Cells(3 + i, 2 + j) = koll(i, j)
'рассчитывается количество деталей каждого вида изготовленных за неделю
    koll_n(i) = koll_n(i) + koll(i, j)
Next j
'результат записывается в соответствующие ячейки
    Sheets("Результат").Cells(3 + i, 8) = koll_n(i)
Next i
 
'на листе "Результат" создаются ячейки с определенными названиями
Sheets("Результат").Activate
Sheets("Результат").Cells(20, 1) = "Результат в денежном эквиваленте"
Sheets("Результат").Cells(21, 1) = "Наименование изделия"
Sheets("Результат").Cells(21, 2) = "Стоимость 1 шт."
Sheets("Результат").Cells(21, 3) = "Заработано"
Sheets("Результат").Cells(22, 3) = "1-й день"
Sheets("Результат").Cells(22, 4) = "2-й день"
Sheets("Результат").Cells(22, 5) = "3-й день"
Sheets("Результат").Cells(22, 6) = "4-й день"
Sheets("Результат").Cells(22, 7) = "5-й день"
Sheets("Результат").Cells(22, 8) = "Всего"
Sheets("Результат").Cells(23, 1) = "болт"
Sheets("Результат").Cells(24, 1) = "винт"
Sheets("Результат").Cells(25, 1) = "гайка"
Sheets("Результат").Cells(26, 1) = "шайба"
Sheets("Результат").Cells(27, 1) = "шуруп"
Sheets("Результат").Cells(28, 1) = "гвоздь"
Sheets("Результат").Cells(29, 1) = "скрепка"
Sheets("Результат").Cells(30, 1) = "сверло"
Sheets("Результат").Cells(31, 1) = "шпилька"
Sheets("Результат").Cells(32, 1) = "дюпель"
Sheets("Результат").Cells(33, 1) = "шкант"
Sheets("Результат").Cells(34, 1) = "саморез"
Sheets("Результат").Cells(35, 1) = "Зубчатое колесо"
Sheets("Результат").Cells(36, 1) = "крюк"
Sheets("Результат").Cells(37, 1) = "швеллер"
Sheets("Результат").Cells(38, 1) = "ИТОГО"
 
'во внешнем цикле происходит вывод стоимости одной детали
'и стоимости всех деталей, произведенных в данный период
For i = 1 To 15
'в этом цикле вычисляется сумма заработков по каждой детали за каждый день
'а также расчет заработной платы за каждый день
  For j = 1 To 5
      Sheets("Результат").Cells(22 + i, 2 + j) = koll(i, j) * cena(i)
      zar(j) = zar(j) + koll(i, j) * cena(i)
zar(6) = zar(6) + koll(i, j) * cena(i)
 Next j
    Sheets("Результат").Cells(22 + i, 2) = cena(i)
    Sheets("Результат").Cells(22 + i, 8) = cena(i) * koll_n(i)
Next i
 
 max_st_det = Application.WorksheetFunction.Max(Sheets("Результат").Range("H23:H37"))
 Sheets("Результат").Cells(41, 1) = "макс.стоимость=" & max_st_det
 For Each cel In Sheets("Результат").Range("H23:H37").Cells
   If cel.Value = max_st_det Then nazw = Sheets("Результат").Cells(cel.Row, 1)
 Next cel
 Sheets("Результат").Cells(40, 1) = "Тип детали с наибольшим заработком:"
 Sheets("Результат").Cells(40, 5) = nazw
 
 
'в соответствующие ячейки выводятся заработок рабочего за неделю
Sheets("Результат").Activate
Sheets("Результат").Cells(38, 8) = zar(6)
Sheets("Результат").Cells(39, 1) = "Заработок за неделю"
Sheets("Результат").Cells(39, 5) = zar(6)
End Sub