Sub Подсчитать()
    Dim countItalic As Long, countNoItalic As Long
    Dim countUnderline As Long, countGeneral As Long
    Dim rng As Range, cel As Range
    'здесь укажите нужный диапазон
    Set rng = Range("A1:A5")
    For Each cel In rng
        If cel.Font.Italic = True Then
            countItalic = countItalic + 1
        Else
            countNoItalic = countNoItalic + 1
        End If
        If cel.Font.Underline <> xlUnderlineStyleNone Then countUnderline = countUnderline + 1
        If (cel.Font.Italic = False) And (cel.Font.Underline = xlUnderlineStyleNone) Then
            countGeneral = countGeneral + 1
        End If
    Next cel
    'здесь в переменных результат.
End Sub

Function СЧЁТСВШРИФТА(rng As Range, Optional cl As Range, Optional it As Boolean = False, Optional bld As Boolean = False, Optional ul = 0)
'rng - диапазон для подсчета ячеек, обязательный
'cl - ячейка со шрифтом-образцом, необязательный
'it - курсив(1)/не курсив(0), необязательный, по умолчанию False(0)
'blt - полужирный(1)/нет(0), необязательный, по умолчанию False(0)
'ul - подчеркнутый(1)/нет(0),необязательный, по умолчанию НЕТ(0)
Dim iCl As Range
If Not cl Is Nothing Then
    With cl.Parent.Range(cl.Address).Font
        it = .Italic: bld = .Bold: ul = .Underline
    End With
End If
If ul = 0 Then
    ul = xlUnderlineStyleNone
Else
    ul = xlUnderlineStyleSingle
End If
For Each iCl In rng
    With iCl.Font
        If .Italic = it And .Bold = bld And .Underline = ul Then
            СЧЁТСВШРИФТА = СЧЁТСВШРИФТА + 1
        End If
    End With
Next
End Function