保護循環中的工作表

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