如何修改VBA代码实现D列单元格为空时锁定对应行E:F列范围

以下是修改后的代码，可实现当D3:D502中某单元格为空时，锁定对应行的E、F列单元格；若D列单元格有内容，则解锁对应E、F列区域：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Dim aCell As Range

    Application.EnableEvents = False

    If Not Intersect(Range("D3:D502"), Target) Is Nothing Then
        ActiveSheet.Unprotect ""
        ' 遍历D3到D502的单元格
        For Each aCell In Range("D3:D502")
            ' 锁定/解锁对应行的E列到F列区域
            If Len(Trim(aCell.Value)) = 0 Then
                aCell.Offset(, 1).Resize(1, 2).Locked = True
            Else
                aCell.Offset(, 1).Resize(1, 2).Locked = False
            End If
        Next
        ActiveSheet.Protect ""
    End If

Letscontinue:
     Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub

关键修改说明 #

• 原代码里aCell.Offset(, 1)仅指向D列单元格右侧的单个E列单元格，修改为aCell.Offset(, 1).Resize(1, 2)后，会选中从E列开始的1行2列区域（即对应行的E、F列单元格）。
• 把原单行条件判断拆成多行，更便于新手阅读和理解逻辑。

可选优化（提升运行效率） #

如果不想每次修改D列单元格都遍历整个D3:D502范围，可以只处理被修改的单元格所在行，代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa

    Dim aCell As Range
    Dim targetCell As Range

    Application.EnableEvents = False

    Set targetCell = Intersect(Range("D3:D502"), Target)
    If Not targetCell Is Nothing Then
        ActiveSheet.Unprotect ""
        For Each aCell In targetCell
            If Len(Trim(aCell.Value)) = 0 Then
                aCell.Offset(, 1).Resize(1, 2).Locked = True
            Else
                aCell.Offset(, 1).Resize(1, 2).Locked = False
            End If
        Next
        ActiveSheet.Protect ""
    End If

Letscontinue:
     Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub

这个版本只会处理你修改的D列单元格对应的行，运行速度更快，适合数据量较大的场景。

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