Формула в макрос

Option Explicit
 
Sub CountWithVBA()
    Application.ScreenUpdating = False
 
    ' Вот тут укажите правильно директорию (папка) где находится ваш файл
    Dim filePath    As String
    filePath = ThisWorkbook.Path & "\" & "31)Трассовка Автоналивная 405..xlsb"
    '    filePath = "C:\Users\GurinEV\Desktop\Приоритеты\5. ТРАССОВКИ\[31)Трассовка Автоналивная 405..xlsb"
 
    Dim wb          As Workbook
    On Error Resume Next
    Set wb = Workbooks.Open(filePath, ReadOnly:=True)
    On Error GoTo 0
 
    If wb Is Nothing Then
        MsgBox "Файл не найден или не удалось открыть.", vbCritical
        Exit Sub
    End If
 
    Dim ws          As Worksheet
    Set ws = wb.Sheets("405")
 
    Dim sh          As Worksheet
    Set sh = ThisWorkbook.Worksheets("Лист1")
 
    Dim lastRow     As Long
    lastRow = ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
 
    Dim dataH As Variant, dataV As Variant
    Dim dataAH As Variant, dataAJ As Variant
    Dim dataAQ As Variant, dataBG As Variant
 
    dataH = ws.Range("H2:H" & lastRow).Value
    dataV = ws.Range("V2:V" & lastRow).Value
    dataAH = ws.Range("AH2:AH" & lastRow).Value
    dataAJ = ws.Range("AJ2:AJ" & lastRow).Value
    dataAQ = ws.Range("AQ2:AQ" & lastRow).Value
    dataBG = ws.Range("BG2:BG" & lastRow).Value
 
    Dim startDate As Date, endDate As Date
    startDate = sh.Range("U2").Value
    endDate = sh.Range("W2").Value
 
    Dim compareRow  As Long
    compareRow = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row
 
    sh.Range("N7:S" & compareRow).ClearContents
 
    Dim dataC       As Variant
    Dim dataR As Variant, dataP As Variant
    dataC = sh.Range("C7:C" & compareRow).Value
    dataR = sh.Range("R7:R" & compareRow).Value
    dataP = sh.Range("P7:P" & compareRow).Value
 
    Dim j As Long, i As Long
    Dim countGoodI As Long, countOtherI As Long, countBG As Long, countRepair As Long
    Dim suitable As Long, notSuitable As Long, welded As Long
 
    Dim results()   As Variant
    ReDim results(1 To compareRow - 6, 1 To 5)
 
    For j = 1 To UBound(dataC, 1)
        countGoodI = 0
        countOtherI = 0
        countBG = 0
        countRepair = 0
        suitable = 0
        notSuitable = 0
        welded = 0
 
        Dim compareString As String
        compareString = dataC(j, 1)
 
        For i = 1 To UBound(dataH, 1)
 
            If InStr(1, dataH(i, 1), compareString, vbTextCompare) > 0 Then
 
                If dataAH(i, 1) = "годен" And dataAJ(i, 1) = "I" Then
 
                    If dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                        countGoodI = countGoodI + 1
                    End If
 
                End If
 
                If dataAH(i, 1) = "" Then
 
                    If dataAQ(i, 1) <> "" Then
 
                        If dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                            countOtherI = countOtherI + 1
                        End If
 
                    ElseIf dataBG(i, 1) <> "" Then
 
                        If dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                            countBG = countBG + 1
                        End If
 
                    End If
 
                ElseIf dataAH(i, 1) = "ремонт" Then
 
                    If dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                        countRepair = countRepair + 1
                    End If
 
                End If
 
                If dataAJ(i, 1) = "I" And dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                    welded = welded + 1
                End If
 
                If dataAQ(i, 1) = "рк" And dataAJ(i, 1) = "I" And dataV(i, 1) >= startDate And dataV(i, 1) <= endDate Then
                    notSuitable = notSuitable + 1
                End If
 
                If dataAH(i, 1) = "годен" And dataAQ(i, 1) = "" And _
                        dataV(i, 1) >= startDate And _
                        dataV(i, 1) <= endDate And _
                        InStr(1, dataH(i, 1), compareString, vbTextCompare) > 0 Then
                    suitable = suitable + 1
                End If
 
            End If
 
        Next i
 
        results(j, 1) = welded
        results(j, 2) = countGoodI + countOtherI + countBG + countRepair
        results(j, 3) = suitable
        results(j, 4) = notSuitable
        results(j, 5) = 0
    Next j
 
    sh.Range("N7:N" & compareRow).Value = Application.Index(results, 0, 1)
    sh.Range("P7:P" & compareRow).Value = Application.Index(results, 0, 2)
    sh.Range("Q7:Q" & compareRow).Value = Application.Index(results, 0, 3)
    sh.Range("R7:R" & compareRow).Value = Application.Index(results, 0, 4)
    sh.Range("S7:S" & compareRow).Value = Application.Index(results, 0, 5)
 
    Dim valueR As Double, valueP As Double
 
    For j = 1 To UBound(dataC, 1)
        valueR = sh.Cells(j + 6, "R").Value
        valueP = sh.Cells(j + 6, "P").Value
 
        If valueP <> 0 Then
            sh.Cells(j + 6, "S").Value = valueR / valueP
        Else
            sh.Cells(j + 6, "S").Value = "-"
        End If
    Next j
 
    sh.Range("S7:S" & compareRow).NumberFormat = "00.00%"
 
    wb.Close False
    Set sh = Nothing
    Set ws = Nothing
    Set wb = Nothing
    Application.ScreenUpdating = True
End Sub