Форум по VBA и MS Office

Sub Макрос1()

    Dim arrLeft(), rngRight As Range, var, arrRes()
    Dim lr As Long, r As Long, c_left As Long, c_right As Long
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Поиск последней строки по столбцу "AB".
    lr = Columns("AB").Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
       
    '3. Копирование данных из левой таблицы в vba-массив (для ускорения макроса).
    arrLeft() = Range("G11:U" & lr).Value
   
    '4. Vba-именование фрагмента, в котором находятся данные правой таблицы.
    Set rngRight = Range("AC11:AZ" & lr)
   
    '5. Создание ячеек в массиве-результате.
    ReDim arrRes(1 To rngRight.Rows.Count, 1 To 1)
   
    '6. Переход к первому столбцу левой таблицы.
    c_left = 1
   
    '7. Включение перехватчика ошибок, если в таблицах будут не числа или
        ' в правой таблице будет пусто (в этом случае будет деление на ноль).
    On Error Resume Next
   
    '8.
    ' Цикл по столбцам правой таблицы.
    For c_right = 1 To rngRight.Columns.Count Step 3
   
        '1) Копирование данных из ячейки из строки 8 (для ускорения работы макроса).
        var = rngRight.Columns(c_right).Cells(1, 1).Offset(-3).Value
       
        '2)
        ' Цикл по строкам левой и правой таблицы.
        For r = 1 To UBound(arrRes, 1) Step 1
            ' Расчёт и запись расчёта в массив-результат.
            arrRes(r, 1) = arrLeft(r, c_left) / var / 60
            ' Если произошла ошибка.
            If Err.Number <> 0 Then
                arrRes(r, 1) = "ОШИБКА!"
                Err.Number = 0
            Else
                ' Ноль не нужно вставлять в эксель.
                If arrRes(r, 1) = 0 Then
                    arrRes(r, 1) = Empty
                End If
            End If
        Next r
       
        '3) Запись результата в правую таблицу в соответствующий столбец.
        rngRight.Columns(c_right + 2).Value = arrRes()
       
        '4) Переход к следующему столбцу в левой таблице.
        c_left = c_left + 2
       
    Next c_right
   
    '9. Отключение перехватчика ошибок.
    On Error GoTo 0
   
    '10. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub