Sub Макрос1()
    
    Dim arr(), boolFound As Boolean
    Dim lngWordCounter As Long, lngBlockCounter As Long
    Dim i As Long, ii As Long, j As Long, lr As Long
    
    lr = Columns("G:H").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
            , SearchFormat:=False).row
    
    For i = 7 To lr Step 3
        arr() = Rows(i).Resize(3).Columns("G:H").value
        For ii = 1 To 3
            For j = 1 To 2
                arr(ii, j) = Trim(arr(ii, j))
            Next j
        Next ii
        boolFound = False
        For ii = 1 To 3
            For j = 1 To 2
                If arr(ii, j) <> "" Then
                    lngWordCounter = lngWordCounter + UBound(Split(arr(ii, j), ","))
                    boolFound = True
                End If
            Next j
        Next ii
        If boolFound = True Then
            lngBlockCounter = lngBlockCounter + 1
        End If
    Next i
    
    Range("F3").value = lngWordCounter
    Range("F2").value = lngBlockCounter

End Sub