VBA Вычислить строку с формулами и вставить ответы как значения в другой строке

Теперь я использую следующий код для генерации всех дат по часам между заданным диапазоном дат. И после этого в строке 16 есть формулы, которые копируются в строку 18, а затем каждая формула автоматически заполняется до последней даты в столбце А. Дата используется в формулах. Код работает нормально, но он работает очень медленно, чтобы вычислять и обновлять все формулы сразу. Я полагаю, что проблема состоит в том, что каждая ячейка после строки 17 является формулой. Так что теперь мне интересно, есть ли способ редактировать код для вычисления каждой формулы в строке 16 на каждый временной интервал, а результат должен быть скопирован как значение из строки 18 до последней строки с датой в столбце A.

Option Explicit Sub TEST() 'Updated on 02-10-2017 Application.Calculation = xlManual Application.StatusBar = "Getting Daily Results...." Application.ScreenUpdating = False ActiveSheet.Rows(18 & ":" & ActiveSheet.Rows.Count).ClearContents Rows("16:16").Copy Destination:=Rows("18:18") Range("A18", Range("A18").End(xlDown)).Clear Dim rng As Range Dim StartRng As Range Dim EndRng As Range Dim OutRng As Range Dim IntvlHrsRng As Range Dim IntvlHrs As Long Dim StartValue As Variant Dim EndValue As Variant Const xTitleId As String = "KutoolsforExcel" Dim ColIndex As Long Dim I As Long Dim ic As Long Dim LastRow As Long Dim LastRowDB As Long Set StartRng = Application.Selection Set StartRng = Range("B3") Set EndRng = Range("B4") Set IntvlHrsRng = Range("B5") Set OutRng = Range("A18") Set OutRng = OutRng.Range("A1") StartValue = StartRng.Range("A1").Value EndValue = EndRng.Range("A1").Value IntvlHrs = IntvlHrsRng.Range("A1").Value If IntvlHrs = 0 Then IntvlHrs = 24 If EndValue - StartValue <= 0 Then Exit Sub End If ColIndex = 0 For I = StartValue * 24 To EndValue * 24 Step IntvlHrs OutRng.Offset(ColIndex, 0) = I / 24 OutRng.Offset(ColIndex, 0).NumberFormat = "dd/mm/yyyy hh:mm" ColIndex = ColIndex + 1 Next I LastRow = Range("A" & Rows.Count).End(xlUp).Row LastRowDB = Range("C" & Rows.Count).End(xlUp).Row If LastRowDB >= LastRow Then Exit Sub End If For ic = 2 To 99 Cells(LastRowDB, ic).AutoFill Destination:=Range(Cells(LastRowDB, ic), Cells(LastRow, ic)) Next ic ActiveSheet.Calculate Application.StatusBar = "Ready" Application.ScreenUpdating = True End Sub 

Давайте будем гением компьютера.