EXCEL复选下拉菜单代码

EXCEL复选下拉菜单代码(待修改,无法删除已选字段)

 

Option Explicit

Private 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
    Else
    Application.EnableEvents = False
    newVal = Target.Value
    Application.Undo
    oldVal = Target.Value
        If oldVal = "" Then
        Else
            If newVal = "" Then
            Else
                Target.Value = oldVal & "," & newVal
            End If
        End If
    End If
    
exitHandler:
Application.EnableEvents = True


End Sub

 

posted @ 2023-05-18 09:36  luckylu1983  阅读(200)  评论(0)    收藏  举报