Question

我正在使用以下代码来允许对单元格下拉列表进行多项选择，但是如果我保护工作表，该代码将停止工作。与其添加以逗号分隔的后续点击，它只是替换了原始选择。

目标单元未锁定，但仍无法正常工作。有什么想法吗？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If ActiveSheet.Cells(3, Target.Column) = "MS" Then
  If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
    GoTo Exitsub
  Else: If Target.Value = "" Then GoTo Exitsub Else
    Application.EnableEvents = False
    Newvalue = Target.Value
    Application.Undo
    Oldvalue = Target.Value
      If Oldvalue = "" Then
        Target.Value = Newvalue
      Else
        If InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
      Else:
        Target.Value = Oldvalue
      End If
    End If
  End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

Answer 1

这将在受保护的工作表上起作用：

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Oldvalue As String, Newvalue As String

    If Target.CountLarge > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    If Me.Cells(3, Target.Column) <> "MS" Then Exit Sub

    On Error GoTo Exitsub
    If HasValidation(Target) Then

        Application.EnableEvents = False
        Newvalue = Target.Value
        Application.Undo
        Oldvalue = Target.Value
        If Oldvalue = "" Then
            Target.Value = Newvalue
        ElseIf InStr(1, Oldvalue, Newvalue) = 0 Then
            Target.Value = Oldvalue & ", " & Newvalue
        Else
            Target.Value = Oldvalue
        End If
        Application.EnableEvents = True

    End If

Exitsub:
    Application.EnableEvents = True
End Sub

Function HasValidation(cell As Range) As Boolean
    Dim t: t = Null

    On Error Resume Next
    t = cell.Validation.Type
    On Error GoTo 0

    HasValidation = Not IsNull(t)
End Function

功能来自于AgentRev的答案： Determine if cell contains data validation

用于选择多个下拉选项的VBA代码不适用于受保护的工作表

1 个答案: