Блокировка определенных ячеек в диапазоне

Question

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

Когда я запускаю приведенный ниже код, в результате весь лист заблокирован. Если я добавлю оператор else, лист разблокируется. В принципе, каким бы ни был последний оператор .locked = (true, false), так получается весь лист.

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

Sub ProtectTheSheet()
Dim chCell As Range
Dim chRng As Range

'Clear the default status
ActiveSheet.Unprotect
Range("A7:I35").Locked = False

Set chRng = ActiveSheet.Range("A7:I35")

'Check cell value in body and lock cells with content
For Each chCell In chRng.Cells
    If chCell.Value <> "" Then Cells.Locked = True
Next chCell

ActiveSheet.Protect

End Sub

Answer 1

Sub ProtectTheSheet()
    Dim chCell As Range
    Dim chRng As Range

    ActiveSheet.Unprotect
    Set chRng = ActiveSheet.Range("A7:I35")

    'Check cell value in body and lock cells with content
    For Each chCell In chRng.Cells
        chCell.Locked = (chCell.Value <> "")
    Next chCell

    ActiveSheet.Protect

End Sub

Answer 2

Проверьте это: http://www.mrexcel.com/archive/VBA/15950b.html

Sub CellLocker()
Cells.Select
' unlock all the cells
Selection.Locked = false
' next, select the cells (or range) that you want to make read only, 
' here I used simply A1
Range("A1").Select
' lock those cells
Selection.Locked = true
' now we need to protect the sheet to restrict access to the cells. 
' I protected only the contents you can add whatever you want
ActiveSheet.Protect DrawingObjects:=false, Contents:=true, Scenarios:=false
End Sub

Если вы скажете Range («A1»). Выберите, тогда блокируется только A1.Вы можете указать несколько ячеек, которые должны быть заблокированы, указав следующее:
A3: A12, D3: E12, J1: R13, W18
Это блокирует A3 до A12 и D3 до E12 и т. Д.

Answer 3

Если вы хотите защитить конкретные ячейки любого конкретного Excel без защиты паролем, вот решение:

Sub ProtectingSheet()

  Workbooks.Open (c\documents\....)

  Dim mainworkBook As Workbook

  Set mainworkBook = ActiveWorkbook

  Worksheets(CellValue).Activate

  mainworkBook.Sheets("Sheet1").Range("A1:AA100").Locked = True

  Range(Cells(1, 2), Cells(1, 25)).Select
  Selection.Locked = False

  ActiveSheet.Protect

End Sub

Answer 4

Вы можете попробовать это.

Public Sub abc()
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("I8:I500, K8:K500, M8:M500, N8:N500").Cells.Locked = False
ActiveSheet.Protect Password:="1234"
End Sub

Answer 5

Я знаю, что это старая ветка, но я тоже застрял на ней некоторое время, и после некоторого тестирования в Excel 2013 я пришел к выводу, включает ли ваш диапазон какую-либо объединенную ячейку

• Объединенные ячейки должны быть полностью включены в этот диапазон (например, объединение должно быть полностью в пределах заблокированного / разблокированного диапазона
• Диапазон объединения может быть больше или, по крайней мере, точно соответствовать диапазону, объединенному ячейками. Если это именованный диапазон, который также работает.

Кроме того, вы не можете заблокировать / разблокировать ячейку, которая уже находится в защищенном диапазоне. Например, если вы запустите:

public sub test()
   Sheet1.range("myNameRange").locked = true
   Sheet1.protect
end sub

Дважды он сработает в первый раз, а во второй раз потерпит неудачу. Поэтому вы должны снять защиту целевого диапазона (или листа) перед ....

Answer 6

Быстрый способ разблокировать непустые ячейки - использовать SpecialCells, см. Ниже.

В моем тестировании этот код обрабатывает объединенные ячейки в порядке , я думаю, именно это и вызывает вашу ошибкув коде Тима, когда он пытается обрабатывать каждую ячейку индивидуально (что, понятно, не является проблемой в коде Тима, он имеет дело с неожиданным результатом)

Вы также можете найти эту мою статью Aбыстрый метод определения диапазона разблокированных ячеек полезно

Sub Quicktest()
    Dim rng1 As Range
    Dim rng2 As Range
    On Error Resume Next
    Set rng1 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlFormulas)
    Set rng2 = ActiveSheet.Range("A7:I35").Cells.SpecialCells(xlConstants)
    On Error GoTo 0
    ActiveSheet.Unprotect
    ActiveSheet.Range("A7:I35").Cells.Locked = False
    If Not rng1 Is Nothing Then rng1.Cells.Locked = True
    If Not rng2 Is Nothing Then rng2.Cells.Locked = True
    ActiveSheet.Protect
End Sub

Answer 7

Я могу что-то упустить, но ...

Cells.Locked = True

... заблокирует все ячейки на активном листе. Если вы просто измените его на ...

chCell.Locked = True

... тогда это работает; Я думаю?! Поскольку диапазон очень мал, вы также можете не разблокировать ячейки в начале, а вместо этого разблокировать ячейки, в то же время блокируя их, например.

For Each chCell In chRng.Cells
    If chCell.Value <> "" Then 
    chCell.Locked = True
    Else
    chCell.Locked = False
    End If
Next chCell

Если вы новичок в VBA, я бы рекомендовал построчно циклически проходить код, как описано в этом видео консультанта по Excel . Если вы пошагово просматриваете код, вы можете проверить, «работает ли ячейка A7 так, как ожидалось?» ... вместо того, чтобы просто увидеть конечный продукт