Выбор ячеек по цвету

[riner19]

Нужен макрос, что бы он выбирал в диапазоне B1:H100 ячейки определенного цвета (16705720 или RGB(184,232,254)) и ставил защиту от редактирования на выбранные ячейки.

[IgorGO]

Sub ProtectSameCells()
  Dim c As Range
  ActiveSheet.Unprotect
  For Each c In [b1:h100].Cells
    If c.Interior.Color = 16705720 Then c.Locked = True
  Next
  ActiveSheet.Protect
End Sub

[riner19]

Огромное спасибо. Выручили

[riner19]

Помогите еще раз
Все сложнее чем казалось.
Нужно в этот диапазон после установки защиты вставить формулу (FormulaR1C1 =******) и после чего снять защиту со всех ячеек.

Спасибо.

[IgorGO]

а) защита ставиться (снимается) на лист, а не на отдельные ячейки
б) для каждой ячейки можно определить будет она защищена или нет, когда будет установлена защита на лист
в) все оказалось еще сложнее... как минимум - для меня. я не понимаю что Вы хотели сказать этим:

Нужно в этот диапазон после установки защиты вставить формулу (FormulaR1C1 =******) и после чего снять защиту со всех ячеек

с точки зренеия формальной логики... мягко говоря, это похоже на бред, извините, пытаюсь высказаться по-мягче

[riner19]

Извините не правильно выразился.

Задача у меня такая, что бы в диапазоне F7:K1500 применить формулу ( "=SUMPRODUCT((ВНГ!$E$13:$E$1500=$D1 16)*(ВНГ!$B$13:$B$1500=$B116)*(ВНГ! H$13:H$1500)+(ННП!$E$13:$e$1500=$D1 16)*(ННП!$B$13:$B$1500=$B116)*(ННП! H$13:H$1500)+(СВ!$E$13:$e$1500=$D11 6)*(СВ!$B$13:$B$1500=$B116)*(СВ!H$1 3:H$1500)+(ВН!$E$13:$e$1500=$D116)* (ВН!$B$13:$B$1500=$B116)*(ВН!H$13:H $1500)+(ЕРМ!$E$13:$e$1500=$D116)*(Е РМ!$B$13:$B$1500=$B116)*(ЕРМ!H$13:H $1500))", но эта формула не должна применяться к определенным ячейкам которые закрашены цветом (16705720) и что бы после выполнения макроса в ячейках с заливкой можно было в ручную вводить текст

[IgorGO]

...
    If c.Interior.Color = 16705720 Then c.Locked = True:  c.clearcontents
...

[riner19]

Хм... Спасибо. Это не совсем то что я хотел, но это натолкнуло меня на кое какую мысль. Сейчас обдумаю, попробую и отпишусь.

[riner19]

Спасибо огромное за помощь.

И ведь точно все что было выще было бредом сам себе усложнял задачу.

Вот оно решение моей задачи:

Sub ProtectSameCells()
Dim c As Range
ActiveSheet.Unprotect
For Each c In [F7:K300].Cells
If c.Interior.Color = 16777215 Then c.FormulaR1C1 = _
"=SUMPRODUCT((ВНГ!R13C5:R300C5=RC4) *(ВНГ!R13C2:R300C2=RC2)*(ВНГ!R13C[2]:R300C[2])+" & _
"(ННП!R13C5:R300C5=RC4)*(ННП!R13C2: R300C2=RC2)*(ННП!R13C[2]:R300C[2])+" & _
"(ВН!R13C5:R300C5=RC4)*(ВН!R13C2:R3 00C2=RC2)*(ВН!R13C[2]:R300C[2])+" & _
"(СВ!R13C5:R300C5=RC4)*(СВ!R13C2:R3 00C2=RC2)*(СВ!R13C[2]:R300C[2])+" & _
"(ЕРМ!R13C5:R300C5=RC4)*(ЕРМ!R13C2: R300C2=RC2)*(ЕРМ!R13C[2]:R300C[2])+" & _
"(ВНГ_!R13C5:R300C5=RC4)*(ВНГ_!R13C 2:R300C2=RC2)*(ВНГ_!R13C[2]:R300C[2])+" & _
"(ННП_!R13C5:R300C5=RC4)*(ННП_!R13C 2:R300C2=RC2)*(ННП_!R13C[2]:R300C[2])+" & _
"(ВН_!R13C5:R300C5=RC4)*(ВН_!R13C2: R300C2=RC2)*(ВН_!R13C[2]:R300C[2])+" & _
"(СВ_!R13C5:R300C5=RC4)*(СВ_!R13C2: R300C2=RC2)*(СВ_!R13C[2]:R300C[2])+" & _
"(ЕРМ_!R13C5:R300C5=RC4)*(ЕРМ_!R13C 2:R300C2=RC2)*(ЕРМ_!R13C[2]:R300C[2]))"
Next
End sub

Вместо того чтобы блокировать ячейки с заливкой. Проще оказалось применить формулу в ячейки без заливки))

[PetyaVova]

IgorGO , а подскажите пожалуйста как скопировать диапазон ячеек выделенных одним цветом в колонку на другом листе, лучше с проверкой на совпадение одинаковых значений и если нет совпадений добавить новое значение?