Защитить рабочие листы в цикле

Question

Следующий код предназначен для блокировки ячеек, соответствующих критериям на каждом листе рабочей книги. Код отлично работает на одном листе, но когда я хочу применить к всей книге, ошибка «неспособна установить заблокированное свойство в класс диапазона».

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

Большое спасибо! Код, как показано ниже, и я сожалею, что я не знаю, как показать правильный формат здесь:

Sub selectnumbers() 
    Dim ws_count As Integer 
    Dim n As Integer 
    ws_count = ActiveWorkbook.Worksheets.Count 
    For n = 2 To ws_count 

     Dim rng As Range 
     Dim cell As Range 
     Dim i As Range 
     Set rng = Nothing 

     For Each cell In ActiveSheet.UsedRange 
      If IsNumeric(cell) = False Or cell.Interior.Pattern = xlLightUp Or cell = "" Then 
      If rng Is Nothing Then 
      Set rng = cell 
       Else 
       Set rng = Application.union(rng, cell) 
      End If 
      End If 
     End If 
     Next cell 

     If Not rng Is Nothing Then 
     rng.Select 
     End If 

     Selection.Locked = True 

     ActiveSheet.Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True _ 
     , AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True 

    Next n 

End Sub 

Answer 1

Там, казалось, дополнительный End If только перед закрытием вложенной For Each cell In .UsedRange.

Я считаю, что ваша основная проблема заключалась в использовании ActiveSheet property. For n = 2 To ws_count не передавал контроль над следующим рабочим листом. Фокус и управление оставались в ActiveSheet.

Sub selectnumbers() 
    Dim ws_count As Long, n As Long 
    Dim rng As Range, cell As Range, i As Range 

    ws_count = ActiveWorkbook.Worksheets.Count 
    For n = 2 To ws_count 
     With Worksheets(n) 

      Set rng = Nothing 

      For Each cell In .UsedRange 
       If Not IsNumeric(cell) Or cell.Interior.Pattern = xlLightUp Or cell = "" Then 
        If rng Is Nothing Then 
         Set rng = cell 
        Else 
         Set rng = Application.Union(rng, cell) 
        End If 
       End If 
      Next cell 

      If Not rng Is Nothing Then 
       rng.Locked = True 
      End If 

      .Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True, _ 
       AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True 

     End With 
    Next n 

End Sub 

Я использовал With ... End With statement передать управление вперед к следующему листу.

Answer 2

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

Sub selectnumbers() 
    Dim ws_count As Long, n As Long 
    Dim rng As Range 
    Dim rng1 As Range 
    Dim rng2 As Range 
    Dim strAddress As String 

    ws_count = ActiveWorkbook.Worksheets.Count 
    For n = 2 To ws_count 
     With Worksheets(n) 

      Set rng = Nothing 
      .UsedRange 

      On Error Resume Next 
      Set rng = .UsedRange.SpecialCells(xlBlanks) 
      If Not rng Is Nothing Then 
       Set rng = Union(rng, .UsedRange.SpecialCells(xlCellTypeFormulas, 22)) 
      Else 
       Set rng = .UsedRange.SpecialCells(xlCellTypeFormulas, 22) 
      End If 
      On Error GoTo 0 


      With Application.FindFormat 
        .Clear 
        .Interior.Pattern = xlLightUp 
      End With 

      Set rng1 = .UsedRange.Find(vbNullString, , xlFormulas, xlPart, xlByRows, xlNext, , True) 
      If Not rng1 Is Nothing Then 
       strAddress = rng1.Address 
       Set rng2 = rng1 
       Do 
        Set rng1 = .UsedRange.Find(vbNullString, rng1, xlFormulas, xlPart, xlByRows, xlNext, , True) 
        Set rng2 = Union(rng2, rng1) 
       Loop Until rng1.Address = strAddress 
      Set rng = Union(rng, rng2) 
      End If 

      If Not rng Is Nothing Then rng.Locked = True 

      .Protect Password:="ADARS", DrawingObjects:=True, Contents:=True, Scenarios:=True, _ 
       AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True 
     End With 
    Next n 

End Sub