Function QualGroup(InResRate As Double) As Integer
    Dim i As Integer
    Dim sup As Range
    
    Worksheets("Таблица соответствий").Activate
    
    i =  0 
    For Each sup In Range("QualGroups")
        If (InResRate > sup.Value) Then
            i = i +  1 
        End If
    Next
    
    QualGroup = i +  1 
    
End Function

Sub CheckPortfs()
    Dim i As Integer
    Dim j As Integer
    Dim col_portf_beg As Integer
    Dim serv_col As Integer
    
    Columns("A:C").Insert Shift = xlLeft
    
    'Собираем данные о проанализированных портфелях
    i = Worksheets("Суждение").Cells.Find("$begin_data").Row
    j =  0 
    serv_col = Worksheets("Суждение").Range("Service_Data").Column +  1 
    col_portf_beg = Worksheets("Суждение").Range("No_Portf_Area").Column
    
    Do While (Worksheets("Суждение").Cells(i, serv_col) <> "$end_data")
        If (Worksheets("Суждение").Cells(i, serv_col) = "$no_portf") Then
            For k =  0  To  7 
                Worksheets("Проверка").Cells(j +  1 ,  1 ) = Worksheets("Суждение").Cells(i, col_portf_beg + k)
                j = j +  1 
            Next
        End If
        i = i +  1 
    Loop
    
    'Собираем данные о портфелях, подлежащих анализу
    i =  2 
    j =  1 
    
    Do While (Worksheets("5.9.2.5 Информация по ПОС").Cells(i,  1 ) <> "")
        Worksheets("Проверка").Cells(j,  2 ) = Worksheets("5.9.2.5 Информация по ПОС").Cells(i,  1 )
        Worksheets("Проверка").Cells(j,  3 ) =  0 
        j = j +  1 
        i = i +  1 
    Loop
    
    'Производим проверку
    Worksheets("Проверка").Activate
    i =  1 
    Do While (Cells(i,  1 ) <> "")
        j = Range("B:B").Find(Cells(i,  1 ).Value).Row
        Cells(j,  3 ).Value = Cells(j,  3 ).Value +  1 
        i = i +  1 
    Loop
    
    'Выписываем необходимое
    i =  1 
    j =  0 
    Do While (Cells(i,  3 ) <> "")
        If (Cells(i,  3 ) <>  0 ) Then
            Range("mistaken_portf").Cells(j +  5 ,  1 ) = Cells(i,  2 )
            Range("mistaken_portf").Cells(j +  5 ,  2 ) = Cells(i,  3 )
            j = j +  1 
        End If
    Loop
    
End Sub