我正在寻找一种方法来清除未锁定单元格的内容。问题是我的工作表有数百个（如果不是数千个）未锁定的单元格和两倍的锁定单元格。遍历它们大约需要 5-7 秒，我想要更高效的东西。
brettdj 的解决方案让我成功了一半，但是在我的范围内有这么多单元格破坏了算法。
线
Set rng3 = ws1.Range(rng2.Address)
由于 rng2 的地址超过了 256 个字符的限制，因此无法正常工作，因此 rng3 变为“无”。
我花了几个小时试图解决 256 的限制，但一无所获。在几乎放弃之后，我偶然发现了一个范围的“区域”对象。救生员！
下面调整后的代码适用于具有多个未锁定单元格的工作表。感谢 brettdj 的最初想法。
' Sub to clear unlocked cells.
Sub clearUnlockedCells()
On Error Resume Next
' If the Workbook is protected, unlock it.
Dim workbook_protected As Boolean
If ActiveWorkbook.ProtectStructure Then
workbook_protected = True
ActiveWorkbook.Unprotect
' If we failed to unlock the Workbook, error out and exit.
If ActiveWorkbook.ProtectStructure Then
MsgBox "Sorry, I could not remove the passsword protection from the workbook" _
& vbNewLine & "Please remove it before running the code again", vbCritical
Exit Sub
End If
End If
Dim source_sheet As Worksheet
Set source_sheet = ActiveSheet
' If the Worksheet is protected, unlock it.
Dim worksheet_protected As Boolean
If source_sheet.ProtectContents Then
worksheet_protected = True
source_sheet.Unprotect
' If we failed to unlock the Worksheet, error out and exit.
If source_sheet.ProtectContents Then
MsgBox "Sorry, I could not remove the passsword protection from sheet" & vbNewLine & source_sheet.name _
& vbNewLine & "Please remove it before running the code again", vbCritical
Exit Sub
End If
End If
On Error GoTo 0
' Disable screenupdating, event code and warning messages.
' Store the calculation and set it to manual.
Dim calc As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
calc = .Calculation
.Calculation = xlCalculationManual
End With
On Error Resume Next
' Check for existing error cells.
Dim tmp_rng As Range
Set tmp_rng = source_sheet.Cells.SpecialCells(xlCellTypeFormulas, 16)
On Error GoTo 0
' Copy the ActiveSheet to a new working sheet.
source_sheet.Copy After:=Sheets(Sheets.Count)
Dim tmp_sheet As Worksheet
Set tmp_sheet = ActiveSheet
' Delete any cells that already contain errors.
If Not tmp_rng Is Nothing Then tmp_sheet.Range(tmp_rng.Address).ClearContents
' Protect the new sheet and add an error formula to all unlocked cells in the
' used range, then use SpecialCells to read the unlocked range address.
tmp_sheet.Protect
On Error Resume Next
tmp_sheet.UsedRange.Formula = "=NA()"
tmp_sheet.Unprotect
' Get the range of cells with "=NA()" in them.
Set tmp_rng = tmp_sheet.Cells.SpecialCells(xlCellTypeFormulas, 16)
' Iterate through the range and create a mirror of that range in the source sheet.
Dim area As Range
Dim source_sheet_range As Range
Dim unlocked_cells As Range
For Each area In tmp_rng.Areas
Set source_sheet_range = source_sheet.Range(area.Address)
If unlocked_cells Is Nothing Then
Set unlocked_cells = source_sheet_range
Else
Set unlocked_cells = Union(unlocked_cells, source_sheet_range)
End If
Next area
' Delete the temp sheet.
tmp_sheet.Delete
On Error GoTo 0
' Protect the Workbook and Worksheet as necessary.
If workbook_protected Then ActiveWorkbook.Protect
If worksheet_protected Then source_sheet.Protect
' Cleanup user interface and settings.
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = calc
End With
' Clean up the unlocked cells.
unlocked_cells.ClearContents
End Sub
希望对其他人有所帮助。如果您只想选择它们而不是清除它们，则将倒数第二行从 .ClearContents 更改为 .Select。