Как более эффективно использовать функцию Count _CellColor?

[Volodshan]

Вам ЭТО надоть - "Количество объектов, площадь которых превышает 1000 м2"?.. Можно ч/з сводную таблицу, формулами "=СЧЁТЕСЛИМН()", "=СУММПРОИЗВ()"... И причём здесь "Count_CellColor"?.. А таблицы следует заполнять как Xl'ю удобнее - без пустых ячеек и объединенных.
ps Как вариант - см. вложение.

[Ищущий ответа]

Объем данных огромен.....Возможно ли написание макроса который менял бы диапазоны при переходе с ячейки напротив наименования на следующую ячейку напротив следующего наименования . Размер диапазона= 1-й пустой ячейке после наименования столбца A и последней пустой ячейке перед следующим наименованием столбца A ?
Например для количества 13 диапазон A5:A69, а для количества 4 диапазон A71:A141 и т.д.

[nilem]

Код на синей стрелке

Sub rty()
Dim x, s As Long, i As Long, j As Long
x = Range("A4:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
j = 4
For i = 1 To UBound(x, 1)
    If Len(x(i, 1)) = 0 Then
        If x(i, 2) > 1000 Then s = s + 1
    Else
        Cells(j, 3) = s: j = i + 3: s = 0
    End If
Next i
Cells(j, 3) = s
End Sub

[Ищущий ответа]

Спасибо Вам огромное ......Как могу я Вас одблагодарить?)

[Hugo121]

Никто не заметил, что в УФ было "Значение ячейки от 1000 до 100000"?
Я заметил, но не знаю, как легко прописать это формулами, поэтому просто привёл =СЧЁТЕСЛИ(B:B;">1000")
Ну а в макросе Николая это условие добавить легко (если конечно нужно отбрасывать >100000)

Option Explicit

Sub rty()
    Dim x, s As Long, i As Long, j As Long
    x = Range("A4:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
    j = 4
    For i = 1 To UBound(x, 1)
        If Len(x(i, 1)) = 0 Then
            If x(i, 2) > 1000 Then
                If x(i, 2) < 100000 Then
                    s = s + 1
                End If
            End If
        Else
            Cells(j, 3) = s: j = i + 3: s = 0
        End If
    Next i
    Cells(j, 3) = s
End Sub