excel如何实现下拉框复选

Private Sub Worksheet_Change(ByVal Target As Range) ' Developed by Contextures Inc. ' www.contextures.com 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 = 7 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 '不是重复选项就视同增加选项         Target.Value = oldVal & "," & newVal '      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