excel多选选取列表VBA未在密码保护表上运行

关于如何更改此设置以允许multiselect在受密码保护的工作表上运行而无需输入密码，您有什么想法吗？

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Oldvalue As String
Dim Newvalue As String
Dim num As Integer

On Error GoTo Exitsub

If Target.Address = "$H$29" Or Target.Address = "$H$33" Or Target.Address = "$H$37" Or Target.Address = "$H$42" Or Target.Address = "$H$58" Or Target.Address = "$H$59" Or Target.Address = "$H$60" Or Target.Address = "$H$63" Or Target.Address = "$H$65" Or Target.Address = "$M$29" Or Target.Address = "$M$33" Or Target.Address = "$M$37" Or Target.Address = "$M$42" Or Target.Address = "$M$58" Or Target.Address = "$M$59" Or Target.Address = "$M$60" Or Target.Address = "$M$63" Or Target.Address = "$M$65" 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
            num = InStr(Oldvalue, Newvalue)
            If num = 0 Then ' If the element selected isnt already on the selected list
              Target.Value = Oldvalue & ", " & Newvalue
            ElseIf num = 1 Then ' If the element is the first on the list
              If Len(Oldvalue) = Len(Newvalue) Then ' If the element is the only element selected
                Target.Value = Replace(Oldvalue, Newvalue, "")
              Else                                  ' If the element is not the only element selected
                Target.Value = Replace(Oldvalue, Newvalue & ", ", "")
              End If
            ElseIf num > 1 Then  ' If the element is not the first
              Target.Value = Replace(Oldvalue, ", " & Newvalue, "")
            End If
        End If
    End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub

---

选项1取消对工作表的保护，运行代码，然后使用VBA再次对其进行保护（但当宏在中间停止时，这可能是不安全的）

选项2使用此代码保护板材

ActiveSheet.Protect "password", UserInterfaceOnly:=True

这样，工作表只受用户更改的保护，而不受宏更改的影响。

SpecialCells（xlCellTypeAllValidation）

在受保护的工作表上抛出错误

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

Private Sub Worksheet_Change(ByVal Target As Range)
    Const SEP As String = ","
    Dim c As Range, NewValue, OldValue, arr, v, lst, removed As Boolean

    On Error GoTo Exitsub

    If Target.CountLarge > 1 Then Exit Sub '<< only handling single-cell changes

    'is the changed cell in our monitored range?
    Set c = Application.Intersect(Target, Me.Range("B5,B7,B9,B11")) ' for example

    If Not c Is Nothing Then
        If Len(c.Value) > 0 And Not c.Validation Is Nothing Then

            Application.EnableEvents = False
            NewValue = c.Value
            Application.Undo
            OldValue = c.Value

            If OldValue = "" Then
                c.Value = NewValue
            Else
                arr = Split(OldValue, SEP)
                'loop over previous list, removing newvalue if found
                For Each v In arr
                    If v = NewValue Then
                        removed = True
                    Else
                        lst = lst & IIf(lst = "", "", SEP) & v
                    End If
                Next v
                'add the new value if we didn't just remove it
                If Not removed Then lst = lst & IIf(lst = "", "", SEP) & NewValue
                c.Value = lst
            End If
        End If    'has validation and non-empty
    End If        'handling this cell

Exitsub:
    If Err.Number <> 0 Then MsgBox Err.Description
    Application.EnableEvents = True
End Sub

Private子工作表\u更改（ByVal目标作为范围）
Const SEP As String=“，”
尺寸c作为范围，新值，旧值，arr，v，lst，作为布尔值删除
关于GoTo Exitsub错误
如果Target.CountLarge>1，则退出Sub'0而不是c。然后验证为Nothing
Application.EnableEvents=False
NewValue=c.值
应用程序。撤消
OldValue=c.值
如果OldValue=“”，则
c、 值=新值
其他的
arr=拆分（旧值，SEP）
'循环上一个列表，如果找到，则删除新值
对于arr中的每个v
如果v=NewValue，则
删除=真
其他的
lst=lst&IIf（lst=“”，“”，SEP）和v
如果结束
下一个v
'如果我们不只是删除它，则添加新值
如果未删除，则lst=lst&IIf（lst=“”，“”，SEP）和NewValue
c、 值=lst
如果结束
如果“已验证且非空”，则结束
如果“正在处理此单元格”，则结束
进出口银行：
如果错误号为0，则MsgBox错误说明
Application.EnableEvents=True
端接头

首先要注意的是：如果Target.Address=this或that或this或that，则替换

如果Intersect（Target，this，that，this，that）

，则使用

If Intersect（Target，this，that）

。这不是问题-更多的是最佳实践您的代码需要在进行任何更改之前取消对工作表的保护，然后在更改完成后重新对其进行保护。尽管如此，如果工作表不受更改的影响，用户如何进行触发宏的更改？用户只需单击上面提到的多选选择列表字段之一（即$h$29），宏允许他选择多个值。但是，一旦我保护工作表，它将只显示一个值。取消对错误处理程序的注释并运行代码-它在哪里出错以及错误消息是什么？只是不确定要添加什么和在哪里插入-我尝试了一些仅使用用户界面的方法，但可能插入错误。工作表保护不是一种安全措施特色。