右键当前sheet页选择查看代码 复制代码保存
Option Explicit 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 = 11 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