循环保护工作表

下面的代码是locking符合工作簿的每个工作表中的条件的单元格。 该代码在单个工作表上工作正常，但是当我想要应用到整个工作簿时，错误“无法将locking的属性设置为范围类”。

工作簿循环程序也是正确的，有人可以告诉我是什么原因造成的错误？

非常感激！ 代码如下，我很抱歉，我不知道如何显示正确的格式在这里：

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 .UsedRangeclosures之前For Each cell In .UsedRange 。

我相信你的主要问题是依赖于ActiveSheet属性 。 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语句将控件传递给下一个工作表。

Answer 2

逐个单元格testing对我来说看起来很慢，所以我使用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