通过Excel VBA，在使用数据验证创建的多选下拉列表中添加“无”选项

Question

在亲爱的@Taller的帮助下，下面的代码为通过数据验证创建的多选下拉列表中的每个选项的首次亮相添加了复选标记。然而，我从经理那里得到了关于应该在列表中添加“无”选项的情况的反馈/批评。当选择“NONE”时，不能同时选择其余选项；当选择其他选项时，不能同时选择“NONE”。是否可以通过VBA编码来解决这个问题？提前非常感谢您。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Oldvalue As String
    Dim Newvalue As String

    Application.EnableEvents = True

    On Error GoTo Exitsub

    If Not Intersect(Target, Range("F4:F29")) Is Nothing 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
                    If AscW(Left(Oldvalue, 1)) <> &H2713 Then
                        Oldvalue = ChrW(&H2713) & Space(1) & Oldvalue
                    End If

                    Target.Value = Oldvalue & vbNewLine & ChrW(&H2713) & Space(1) & 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

    Application.EnableEvents = True
    On Error GoTo Exitsub

    If Not Intersect(Target, Range("F4:F29")) Is Nothing 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
                If Newvalue = "NONE" Then
                    Target.Validation.Delete 'delete the cell validation if nothing existed in cell
                End If
            Else
                If Newvalue = "NONE" Then
                    'extract the existing validating list:
                    Dim exList: exList = Split(Target.value, vbNewLine)
                    With Target.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                                                  Formula1:=Join(exList, ",") 'keep only existing Target values
                    End With
                Else
                    If InStr(1, Oldvalue, Newvalue) = 0 Then
                        If AscW(left(Oldvalue, 1)) <> &H2713 Then
                            Oldvalue = ChrW(&H2713) & space(1) & Oldvalue
                        End If
    
                        Target.value = Oldvalue & vbNewLine & ChrW(&H2713) & space(1) & Newvalue
                    Else:
                        Target.value = Oldvalue
                    End If
                End If
            End If
        End If
    End If

Exitsub:
    Application.EnableEvents = True
End Sub

上面的代码处理的是在

Source

...

中输入逗号分隔的字符串得到的验证列表

如果您以不同的方式进行验证，那么是时候解释一下您是如何做到的了。