Прошу знатоков помочь, задача трудная. Под силу только сильным логикам.

[Михаил С.]

По шагам прогнал - все отрабатывает, но все равно 40 считает.

[kuklp]

Понял, Миш. Запустил в 2010 - та же ерунда. Неправильно считает counta. Замени на:
MyCount = Application.Sum(b) - 1
Это мелкие виноваты! В 2003 и 2007 считает правильно.

[Михаил С.]

Ну я тоже до этого

MyCount = Application.Sum(b) - 1

допер, правда чуть позже, чем ты на форум выложил.

[MCH]

Без макросов:
формула массива:

Код Выделить Развернуть

=СУММ(ЗНАК(МУМНОЖ((СТРОКА(ИНДЕКС(A:A;1):ИНДЕКС(A:A;МАКС(C2:C9)-МИН(B2:B9)+1))-1+МИН(B2:B9)>=ТРАНСП(B2:B9))*(СТРОКА(ИНДЕКС(A:A;1):ИНДЕКС(A:A;МАКС(C2:C9)-МИН(B2:B9)+1))-1+МИН(B2:B9)<=ТРАНСП(C2:C9));1^B2:B9)))-1

[MCH]

еще вариант UDF:

Код Выделить Развернуть

Function MyCount2&(r As Range)
    Dim a, i&, b As Range, m&
    a = r
    m = Application.Min(a)
    For i = 1 To UBound(a)
        If b Is Nothing Then
            Set b = Range(Cells(a(i, 1) - m + 1, 1), Cells(a(i, 2) - m + 1, 1))
        Else
            Set b = Union(b, Range(Cells(a(i, 1) - m + 1, 1), Cells(a(i, 2) - m + 1, 1)))
        End If
    Next i
    MyCount2 = b.Count - 1
End Function