Question

我有这个脚本，可以锁定工作簿中保存有数据的所有单元格，然后用密码保护它们。它可以正常工作，但是由于工作簿有39张纸，因此每次最多可能需要5分钟的时间来保存。有谁知道我该如何精简以使其更快？

` Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


     'Resume to next line if any error occurs
     On Error Resume Next

    Dim WS_Count As Integer
    Dim I As Integer
    Dim Cell As Range



    'Set WS_Count equal to the number of worksheets in the active workbook.
    WS_Count = ActiveWorkbook.Worksheets.Count

    'loop through all of the Worksheets
    For I = 1 To WS_Count
        With ActiveWorkbook.Worksheets(I)
             'first of all unprotect the entire sheet and unlock all cells
            .Unprotect Password:="password"
            .Cells.Locked = False
             'Now search for non blank cells and lock them
             'unlock blank cells
            For Each Cell In ActiveWorkbook.Worksheets(I).UsedRange
                If Cell.Value <> "" Then
                    Cell.Locked = True
                ElseIf Cell.Value = "" Then
                    Cell.Locked = False
                End If
            Next Cell
            'Now protect the entire sheet
            .Protect Password:="password"
        End With
    Next I

    Exit Sub
End Sub

Answer 1

一次迭代一个单元以锁定它们是一项耗时的任务。我还没有调查花费时间的是锁定还是循环，但是我怀疑是循环。当然，锁定Range会更快。

因此，如果您的工作表可以使用SpecialCells函数定义范围，那么这可能是一种更快的方法：

ws.UsedRange.SpecialCells(xlCellTypeBlanks).Locked = True

如果定义范围的区域过多（例如，VBA不会抛出错误，而是冻结直到您单击“中断”），并且需要处理“未找到任何单元格”，则可能会出现问题。错误。

我刚刚对39个工作表进行了这样的调用，该工作表具有500行乘100列和20％的随机空白单元，并且花费的时间不到一秒钟。

但是，您可能会发现，您可以在完成每个工作表时对其进行“锁定”（而不是在保存之前进行大批量的锁定），例如在Worksheet_Deactivate事件中。如果您保持锁定状态（例如，可以使用“命名范围”或在隐藏的工作表上执行此操作），则只需在保存之前对任何仍处于打开状态的锁定程序运行锁定例程。在下面的示例代码中，我做出了这些假设，以使您了解其工作方式。显然，您需要根据自己的标准和用途对其进行更改，但是希望它可以助您一臂之力。代码全部在ThisWorkbook对象后面的代码中：

Option Explicit


Private Sub Workbook_Open()
'----------------------------------------------------------
' Initialises worksheet locked states.
' Note 1: only locks the ones which are not locked.
'----------------------------------------------------------
    Dim ws As Worksheet
    Dim n As Name

    On Error GoTo EH

    Application.ScreenUpdating = False
    For Each ws In Me.Worksheets
        If Not SavedState(ws) Then SavedState(ws) = True
    Next
    Application.ScreenUpdating = True

    Exit Sub

EH:
    Debug.Print Err.Number; Err.Description
End Sub

'----------------------------------------------------------
' Iterates the worksheets to lock any that remain unlocked.
'----------------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet
    Dim n As Name

    On Error GoTo EH

    Application.ScreenUpdating = False
    For Each ws In Me.Worksheets
        If Not SavedState(ws) Then SavedState(ws) = True
    Next
    Application.ScreenUpdating = True

    Exit Sub

EH:
    Debug.Print Err.Number; Err.Description
End Sub

EH:
    Debug.Print Err.Number; Err.Description
End Sub

'----------------------------------------------------------
' Unlocks Sheet1 for user to work on.
' CAUTION: not necessarily what you want,
'          but I've put it in as an example of the syntax
'          to unlock any sheet.
'----------------------------------------------------------
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim ws As Worksheet

    'Exit if it's not the target sheet.
    If Not Sh Is Sheet1 Then Exit Sub

    On Error GoTo EH
    Set ws = Sh
    SavedState(ws) = False
    Exit Sub

EH:
    Debug.Print Err.Number; Err.Description
End Sub

'----------------------------------------------------------
' Locks this worksheet now that user is finished with it.
'----------------------------------------------------------
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Dim ws As Worksheet

    On Error GoTo EH
    Set ws = Sh
    SavedState(ws) = True
    Exit Sub

EH:
    Debug.Print Err.Number; Err.Description
End Sub

'----------------------------------------------------------
' Gets the saved state of the IsLocked flag.
' Note 1: retrieves value from "IsLocked" named range.
' Note 2: returns False if there's an error.
'----------------------------------------------------------
Private Property Get SavedState(ws As Worksheet) As Boolean
    Dim n As Name

    On Error GoTo EH
    Set n = ws.Names("IsLocked")
    SavedState = n.RefersTo
    Exit Property

EH:
    SavedState = False
End Property

'----------------------------------------------------------
' Sets the saved state of the IsLocked flag.
' Note 1: sets value of "IsLocked" named range.
' Note 2: creates a new named range if it doesn't exist.
'----------------------------------------------------------
Private Property Let SavedState(ws As Worksheet, RHS As Boolean)
    Dim n As Name

    On Error Resume Next
    Set n = ws.Names("IsLocked")
    On Error GoTo EH

    'Create the name if it doesn't exist.
    If n Is Nothing Then
        Set n = ws.Names.Add(Name:="IsLocked", RefersTo:=True)
    End If

    'Set the locked and protection values.
    If RHS Then
        With ws
            .Unprotect "pw"
            .Cells.Locked = False
            On Error Resume Next 'handles no blank cells error.
            .UsedRange.SpecialCells(xlCellTypeBlanks).Locked = True
            On Error GoTo EH
            .Protect "pw"
        End With
    Else
        With ws
            .Unprotect "pw"
            .Cells.Locked = False
        End With
    End If

    'Set the named range value.
    n.RefersTo = RHS
    Exit Property

EH:
    Debug.Print Err.Number; Err.Description
End Property

在VBA for Excel中简化单元锁定

1 个答案: