我正在使用以下代码来允许对单元格下拉列表进行多项选择,但是如果我保护工作表,该代码将停止工作。与其添加以逗号分隔的后续点击,它只是替换了原始选择。
目标单元未锁定,但仍无法正常工作。有什么想法吗?
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
答案 0 :(得分:0)
这将在受保护的工作表上起作用:
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