受保护工作表中多值下拉列表VBA变更事件失效求助

原代码的核心问题 #

1. 拼写错误：SpecialClls应为SpecialCells，这个错误会导致代码直接跳转到结束逻辑，根本无法执行值合并的核心功能。
2. 工作表保护处理不当：仅简单调用Unprotect和Protect，未使用UserInterfaceOnly:=True参数，导致宏无法在保护状态下修改单元格。

修正后的完整代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String
    Dim ws As Worksheet
    Set ws = Me ' 绑定当前事件的工作表，比ActiveSheet更可靠
    
    Application.EnableEvents = True
    On Error GoTo Exitsub
    
    ' 仅处理第27列（AA列）的单个单元格
    If Target.Column <> 27 Or Target.Cells.Count > 1 Then
        GoTo Exitsub
    End If
    
    ' 检查单元格是否带有数据验证
    On Error Resume Next
    Dim validRange As Range
    Set validRange = Target.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo Exitsub
    If validRange Is Nothing Then
        GoTo Exitsub
    End If
    
    ' 跳过空值输入
    If Target.Value = "" Then
        GoTo Exitsub
    End If
    
    ' 解锁工作表（如果处于保护状态）
    If ws.ProtectContents Then
        ws.Unprotect Password:="secret"
    End If
    
    ' 获取新值与旧值
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
    
    ' 合并值（避免重复）
    If Oldvalue = "" Then
        Target.Value = Newvalue
    Else
        ' 不区分大小写检查重复，需要区分则去掉vbTextCompare
        If InStr(1, Oldvalue, Newvalue, vbTextCompare) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
        Else
            Target.Value = Oldvalue
        End If
    End If
    
    ' 重新保护工作表，允许宏修改单元格
    ws.Protect Password:="secret", UserInterfaceOnly:=True
    
Exitsub:
    Application.EnableEvents = True ' 确保事件始终恢复启用
End Sub

关键修改说明 #

• 修正了SpecialCells的拼写错误，让数据验证检查逻辑正常运行。
• 使用Me指代当前工作表，避免切换工作表时出现错误。
• 增加批量修改判断，防止粘贴多个单元格时触发异常。
• 加入UserInterfaceOnly:=True参数：设置后，工作表仅对用户操作锁定，宏可以直接修改单元格，无需每次都解锁（关闭文件后需重新设置，可在工作簿打开事件中自动执行）。
• 优化重复值检查，加入不区分大小写的选项（可根据需求调整）。

额外注意事项 #

• 确保代码中的密码"secret"与你的工作表保护密码完全一致。
• 如果需要每次打开文件都自动启用UserInterfaceOnly，可以在ThisWorkbook的Workbook_Open事件中添加以下代码：

  Private Sub Workbook_Open()
      Me.Worksheets("你的工作表名称").Protect Password:="secret", UserInterfaceOnly:=True
  End Sub
  

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