Function СрЖелтых(Диапозон As Range)
Dim а As Long, б As Long, в As Double
б = 0
в = 0

For а = 1 To Диапозон.CountLarge
 If Диапозон(а).Interior.Color = 65535 Then
    б = б + 1
    в = в + Диапозон(а)
    End If
 Next а
СрЖелтых = в / б
End Function

Sub iColor()
Dim cell As Range
Dim iSumma As Double
Dim n As Long
Dim iLastRow As Long
iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
  For Each cell In Range("B4:C" & iLastRow)
    If Not IsEmpty(cell) And cell.Interior.ColorIndex = Range("D1").Interior.ColorIndex _
                         And Cells(cell.Row, 1) = "яблоки" Then
      iSumma = iSumma + cell
      n = n + 1
    End If
  Next
  MsgBox "Сумма ячеек с наим. яблоки: " & iSumma & vbCrLf & _
         "количество ячеек с наим. яблоки: " & n
End Sub