Sub makros()
    Dim role As String
    Dim k As Integer
role = "Яблоко"
k = 0
For i = 2 To 10001
    If role = True Then
    k = k + 1
    End If
Next i
Cells(1, 1) = k
End Sub