Private Sub Worksheet_Change(ByVal Target As Range)
    lr = Cells(Rows.Count, "e").End(xlUp).Row
    If Not Intersect(Target, Range("e3:g" & lr)) Is Nothing Then
        Dim kolTotal&, kolOk&
'        kolTotal = lr - 7' Кол-во ВСЕХ полей
        kolTotal = WorksheetFunction.CountIf(Range("d8:d" & lr), "!") ' Кол-во всех обязательных полей
        With CreateObject("Scripting.Dictionary"): .CompareMode = 1
            For i = 8 To lr
                If Cells(i, "g") = "" And Cells(i, "d") = "!" Then
                    If Trim(Cells(i, "e")) <> "" Then .Item(Trim(Cells(i, "e"))) = .Item(Trim(Cells(i, "e"))) + 1
'                Else                           считаем кол-во строк со статусом ОК
'                    kolOk = kolOk + 1
                ElseIf Cells(i, "d") = "!" Then 'считаем только заполненные обязательные поля
                    kolOk = kolOk + 1
                End If
            Next i
            Range("a2", [a2].End(xlDown)).ClearContents
            If .Count <> 0 Then Range("a2:a" & .Count + 1) = Application.WorksheetFunction.Transpose(.keys)
        End With
        Range("b2") = kolOk / kolTotal
    End If
End Sub