如何快速保护/锁定Excel工作表中的批量非连续单元格区域？

原代码慢的核心原因 #

你当前的循环逐个处理单元格地址，每次调用.Range(tmp(i))都会触发Excel对象模型的交互，当单元格数量较多时，频繁的交互会导致速度骤降。一次性处理合并后的非连续区域是提速的关键。

优化方案 #

核心思路是用Union方法将所有需要修改的单元格合并成一个单一的Range对象，然后一次性（或批量）修改其Locked属性，大幅减少Excel交互次数。同时修正原代码中的索引越界、参数传递错误等问题。

优化后的完整代码

主宏：ResultsRangeProtectionV2

Sub ResultsRangeProtectionV2(Optional RangeStatus As Boolean = False)
    ' 关闭Excel的非必要功能，进一步提速
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    Dim sh As Worksheet, wsName As Variant, CurrName As Variant, rng As Range
    Dim targetRng As Range, i As Long
    
    wsName = Array("Janvier")
    
    ' 筛选出需要修改锁定状态的单元格
    Set sh = Worksheets("Janvier")
    Set rng = sh.Range("I7:I" & sh.Range("A5000").End(xlUp).Row)
    Set targetRng = Nothing
    
    For i = 1 To rng.Rows.Count
        With rng.Cells(i)
            ' 排除包含"sultats"或带公式的单元格
            If Not (.Value Like "*sultats*" Or .HasFormula) Then
                If targetRng Is Nothing Then
                    Set targetRng = .Cells
                Else
                    Set targetRng = Union(targetRng, .Cells)
                End If
            End If
        End With
    Next
    
    ' 批量处理每个工作表
    For Each CurrName In wsName
        Set sh = Worksheets(CurrName)
        With sh
            .Protect Password:="MDP", UserInterfaceOnly:=True
            ' 先批量设置I6:I5000的反向锁定状态
            .Range("I6:I5000").Locked = Not RangeStatus
            ' 处理目标非连续区域
            Call CellsLocker(targetRng, sh, RangeStatus)
        End With
    Next
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

辅助宏：CellsLocker

Sub CellsLocker(targetRng As Range, sh As Worksheet, Optional RangeStatus As Boolean = False)
    If targetRng Is Nothing Then Exit Sub
    
    ' 若需要跳过合并单元格，保留以下循环
    Dim cell As Range
    For Each cell In targetRng
        If Not cell.MergeCells Then
            cell.Locked = RangeStatus
        End If
    Next
    
    ' 若无需跳过合并单元格，直接替换为这一行：
    ' targetRng.Locked = RangeStatus
End Sub

关键优化点 #

1. 使用Union合并区域：将所有目标单元格合并为一个Range对象，仅需1次（或少量）Excel交互，替代原代码的数百/数千次交互。
2. 修正索引错误：原代码循环从i=0开始，导致rng(i)下标越界，改为从i=1遍历单元格。
3. 移除冗余地址数组：直接操作Range对象，避免存储和解析地址字符串的额外开销。
4. 关闭Excel非必要功能：临时关闭屏幕更新、事件触发和自动计算，进一步减少运行耗时。
5. 修复参数传递错误：原代码传递未初始化的outputArray的UBound，改为直接传递合并后的Range对象。

内容的提问来源于stack exchange，提问作者OneTwentyTo