下拉复选项目中的排除项代码怎么写

woniu3721

这个表是可以 下拉进行复选的，现在要的是如果选择不限，那么其他已有的选择项目都应删除，如果选择除了不限之外的任何一项，那么就把不限这个选项删除，该怎么修改添加代码？另外就是这个代码只对1列有效，如果对其他列同样有效该怎么修改

下拉复选.zip (17.89 KB, 下载次数: 8)

2024-5-15 22:00 上传

点击文件名下载附件

山菊花

Sub Worksheet_Change(ByVal Target As Range)
    '让数据有效性选择 可以多选,重复选
    Dim rngDV As Range
    Dim oldVal As String
    Dim newVal As String
    If Target.Count > 1 Then GoTo exitHandler

    On Error Resume Next
    Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
    On Error GoTo exitHandler

    If rngDV Is Nothing Then GoTo exitHandler

    If Intersect(Target, rngDV) Is Nothing Then
        'do nothing
    Else
        Application.EnableEvents = False
        newVal = Target.Value
        Application.Undo
        oldVal = Target.Value
        Target.Value = newVal
        If Target.Column <= 3 Then '这里规定好哪一列的数据有效性是多选的，A列是第1列，依次类推，如3就是C列，7就是G列
            If oldVal = "" Then
                'do nothing
            Else
                If newVal = "" Then
                    'do nothing
                Else
                    If InStr(1, oldVal, newVal) <> 0 Then  '重复选择视同删除
                        If InStr(1, oldVal, newVal) + Len(newVal) - 1 = Len(oldVal) Then '最后一个选项重复
                            Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 1)
                        Else
                            Target.Value = Replace(oldVal, newVal & "@", "") '不是最后一个选项重复的时候处理逗号
                        End If
                    Else '不是重复选项就视同增加选项
                        If oldVal = "不限" Or newVal = "不限" Then
                            Target.Value = newVal
                        Else
                            Target.Value = oldVal & "@" & newVal
                        End If
                        '      NOTE: you can use a line break,
                        '      instead of a comma
                        '      Target.Value = oldVal _
                            '        & Chr(10) & newVal
                    End If
                End If
            End If
        End If
    End If

exitHandler:
    Application.EnableEvents = True
End Sub

jx928867128

版主太强大了，这个实用

woniu3721

山菊花 发表于 2024-5-16 06:28
Sub Worksheet_Change(ByVal Target As Range)
    '让数据有效性选择 可以多选,重复选
    Dim rngDV As ...

厉害，真的牛掰！