Марокс для excel по защите строк

[evutk]

Никто не подскажет, как сделать макрос, чтобы автоматически протектились ячейки определенного цвета? Желательно написать по-подробнее... буду очень благодарен!

[IgorGO]

Тема: макрос по защите строк, а спрашиваете как защитить ячейки.

Sub ProtectXX(xx)
  On Error Resume Next
  ActiveSheet.Unprotect
  For Each c In Cells
    c.Locked = c.Interior.Color = xx
  Next
  ActiveSheet.Protect
End Sub

этот макрос защитит ячейки цветом хх, а остальные откроет.

[evutk]

Очень благодарен за идеальный ответ но, возникла одна проблемка, после данного кода excel полностью виснет не подскажите, в чем может быть причина?

[evutk]

Если это происходит из-за мощности компьютера (эксель долго обрабытывает каждую ячейку), то можно ли как-нибудь облегчить данный цикл? И хотел бы точно удостовериться, что правильно понимаю код:
Sub Protect()
On Error Resume Next
ActiveSheet.Unprotect
For Each c In Cells
c.Locked = c.Interior.ColorIndex = 6
Next
ActiveSheet.Protect
End Sub

--> он будет лочить все ячейки желтого цвета (ColorIndex = 6), правильно ведь?

[EducatedFool]

Попробуйте такой вариант:

Sub PaintCells()    ' красим некоторые ячейки в красный цвет
    ActiveSheet.UsedRange.Clear
    For i = 4 To 20
        For j = 6 To 32
            If (i + j) Mod 5 = 2 Then Cells(j, i).Interior.Color = vbRed
        Next
    Next
End Sub

Sub ЗащититьКрасныеЯчейки()    'защищаем красные ячейки
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Cells ' перебираем все ячейки в используемой области листа
        cell.Locked = (cell.Interior.Color = vbRed) ' блокируем красные ячейки
    Next
    ActiveSheet.Protect UserInterfaceOnly:=True, Password:="456" ' защищаем лист с паролем 456
End Sub


Sub СнятьЗащитуЛиста()
    ActiveSheet.Unprotect Password:="456"
End Sub

Сначала запустите макрос PaintCells, потом - макрос ЗащититьКрасныеЯчейки

По сути, всё то же самое, что и в примере от IgorGO, только вместо перебора всех ячеек листа (For Each c In Cells)
происходит перебор ячеек в используемой области листа - ActiveSheet.UsedRange.Cells

Возможно, разница в одном слове - UsedRange - значительно увеличит скорость обработки.

[evutk]

Всем большущие спасибо!!!

[evutk]

Только еще один маленький вопрос: как можно это сделать на большее количество цветов, а то я как не пытаюсь через if сделать или простым дублированием - ничего не помогает

[IgorGO]

так даже правильнее будет: предыдущий код присваивал статус "защищаемая"/"незащищаемая" всем ячейкам. Ячейки которые не имели нужного цвета - становились "беззащитными"..., теперь их просто "не трогают".
For Each c In Cells
if c.Interior.Color = xx then
c.Locked = True: Exit sub
end if
if c.Interior.Color = yy then
c.Locked = True: Exit sub
end if
.... и так по всем цветам
Next

[evutk]

IgorGO,
к сожаленю, после и этого Вашего кода, мой эксель-файлик просто, намертво, виснет есть ли какой-нибудь более облегченный вариант?

[EducatedFool]

Попробуйте так:

Sub ЗащититьЦветныеЯчейки()
    Dim cell As Range
    For Each cell In ActiveSheet.UsedRange.Cells    ' перебираем все ячейки в используемой области листа
        Select Case cell.Interior.ColorIndex
            Case 4: cell.Locked = True    ' блокируем ячейки этого цвета
            Case 6: cell.Locked = True    ' блокируем ячейки этого цвета
            Case 7: cell.Locked = True    ' блокируем ячейки этого цвета
            Case 11: cell.Locked = True    ' блокируем ячейки этого цвета
            Case 55: cell.Locked = True    ' блокируем ячейки этого цвета
        End Select
    Next
    ActiveSheet.Protect UserInterfaceOnly:=True, Password:="456"    ' защищаем лист с паролем 456
End Sub