| 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 | 
