Option Compare Text
Sub test()
    Dim lastrowto As Long, e As Long, a As Long, lastrowdel As Long
        
    Set result = Worksheets("result")
    Set result1 = Worksheets("лист1")
    
    lastrowto = result.Cells(1, 5).End(xlDown).Row
    lastrowdel = result1.Cells(1, 8).End(xlDown).Row
    For e = lastrowto To 1 Step -1
        For a = 1 To lastrowdel
            If result.Cells(e, 7).Value Like result1.Cells(a, 8).Value Then
                result.Cells(e, 7).EntireRow.Delete
                Exit For
            End If
        Next a
    Next e
End Sub

pReg.Pattern = "[A-zА-я].*?\d{4} ?- ?\d{4}\)?"

Function Транш(Даты As Range, Суммы As Range, Дата As Range)
    arrD = Даты.Value
    arrS = Суммы.Value
    
    tSumm = 0
    
    For i = 1 To UBound(arrD, 1)
        If arrD(i, 1) > Дата.Value Then
            Транш = Транш + tSumm
            tSumm = 0
        Else
            tSumm = arrS(i, 1)
        End If
    Next i
End Function

Function myRank(mCell As Range, mRange As Range, mCond As Range)
    
    q = ""
    For Each cell In mRange
        If CStr(cell.Value) = mCond.Value Then
            q = q + Cells(cell.Row, mCell.Column).Address + ","
        End If
    Next
    
    If q = "" Then
        myRank = 0
    Else
        With mCell.Worksheet
            Set rngR = .Range(Left(q, Len(q) - 1))
            myRank = Application.WorksheetFunction.Rank(mCell, rngR, 1)
        End With
    End If
End Function