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

问：

在 Dear @Taller 的帮助下，下面的代码在使用数据验证创建的多选下拉列表中为每个选项的首次亮相添加了复选标记。但是，我从我的经理那里得到了关于应该在列表中添加“无”选项的情况的反馈/批评。选择“无”时，不能选择其余选项，而选择其他选项时，不能同时选择“无”。是否可以通过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

Excel VBA 验证 IF-语句下拉列表

请更好地解释“当选择'NONE'时，其余选项不能选择，而当选择其他选项时，不能同时选择'NONE'”的含义“......如果我理解 1：只有在没有其他选择存在并且之后无法选择任何内容时才能选择“无”，或者 2：如果至少进行了一次先前选择，则无法再选择“无”，这是否正确？请考虑一下并澄清问题。我们不太在乎你老板的意愿。你必须从讨论的角度解释你需要什么......

0赞 PYC 11/1/2023

对不起，我不在电脑前。你说的完全正确。如果选择“NONE”，则单元格中不应接受其他选项。同样，如果之前选择了“NONE”以外的选项，则不应将“NONE”接受到单元格中。

答：

2赞 FaneDuru 11/1/2023 #1

您的问题在选择“无”时要做什么方面不是很清楚。我问了一个澄清问题，但你没有回答。如果在空的此类列表验证单元格中选择“NONE”，则下一个代码将清除验证列表，并在选择“NONE”时仅保留验证列表中先前选定的项目：

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

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

已编辑：

请使用下一个版本。它应该做你需要的（我理解的）：

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
            ElseIf Oldvalue = "NONE" Then
                'DO NOTHING...
            Else
                If Newvalue = "NONE" Then GoTo Exitsub
                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

Exitsub:
    Application.EnableEvents = True
End Sub

@PYC 如果你定义了目标，它当然应该是一种方式......那么，如果相应的单元格中不存在任何内容，您希望在按下“无”后发生什么？写“无”，但从那一刻起，即使列表验证存在，也没有什么可以接受的？那么，第二部分，即在之前存在一些选项之后与“无”选择相关的部分，是您需要的，或者在解决第一部分后，您将返回这一部分？

1赞 FaneDuru 11/1/2023

@PYC 我得不到你。不知何故，当之前没有选择任何内容时，选择了“无”的问题。用其他更清晰的词。列表中不会发生任何更改，但如果选择“无”，则在用户尝试选择项目时不会执行任何操作。我不明白当已经选择并选择“无”时该怎么办。您的意思是不干涉验证列表，但如果有人选择“无”，则不会发生任何事情？在不明确你想要什么的情况下工作是浪费时间。所以，请做我最初要求的......

1赞 FaneDuru 11/1/2023

@PYC 请测试我在编辑后发布的版本并发送一些反馈。

1赞 FaneDuru 11/1/2023

@PYC 很高兴我能帮上忙！但你必须知道，如果我们不能清楚地了解你的需求，我们就无法帮助你......如果难以用语言解释，显示初始情况和两种情况的所需输出的图片可能会有所帮助。

上一个：在 if 语句中，我想检查一个单元格，如果“水”在单元格中的某个地方，它是真的

下一个：复制粘贴后如何制作空白单元格

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

By Excel VBA, adding 'NONE' option in a multi-select dropdown list created with data validation

评论

评论