Function КЦ(диапазон As Range, цвет As Range) As Long

     Dim c As Range
     Dim myPreviousAddress As String
      
     For Each c In диапазон
          
         'Смотрим, не относится ли текущая ячейка к
             'объединённой области, которую мы уже подсчитали.
         If myPreviousAddress <> c.MergeArea.Address Then
          
             If c.Interior.ColorIndex = цвет.Interior.ColorIndex Then
              
                 КЦ = КЦ + 1
                  
             End If
              
             'Запоминаем объединённый адрес,
                 'к которому относится текущая ячейка.
             myPreviousAddress = c.MergeArea.Address
              
         End If
      
     Next c
      
End Function

Function КЦ(диапазон As Range, цвет As Range) As Long

        Application.Volatile True
            
            
        'Удобнее писать код с подключённой библиотекой.
            'Библиотеку можно так подключить:
            'Tools - References... - Microsoft Scripting Runtime
        Dim dicMy As Object 'Scripting.Dictionary
        Dim c As Range
            
            
        'Создаём словарь, в который будем записывать те ячейки
            'или объединённые области, который мы уже подсчитали.
        Set dicMy = CreateObject(Class:="Scripting.Dictionary")
            
        For Each c In диапазон
            
            'Смотрим, есть ли в словаре элемент, имя которого - это адрес
                'уже подсчитанной ячейки или объединённой области ячеек.
            'Если нет элемента с таким именем.
            If dicMy.Exists(Key:=c.MergeArea.Address) = False Then
                
                'Смотрим цвет ячейки.
                'Если у ячейки нужный цвет.
                If c.Interior.ColorIndex = цвет.Interior.ColorIndex Then
                    
                    'Подсчитываем.
                    КЦ = КЦ + 1
                        
                    'Создаём в словаре элемент с именем, которое
                        'представляет собой адрес объединённой области.
                    'Key - это имя элемента в словаре.
                    'Item - это данные, которые содержатся в элементе.
                        'Нам данные в данном случае не нужны, но
                        'синтаксис команды "Add" требует,
                        'чтобы мы указали параметр "Item".
                    dicMy.Add Key:=c.MergeArea.Address, Item:=""
                        
                End If
                    
            End If
                
        Next c
            
End Function