Excel – 多选下拉列表 – 不重复select

我已经开发了我的Excel电子表格，可以使用下面的代码在下拉列表中select多个项目：

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

但是，我想现在validation下拉列表项只能select一次的答案。 最好是，如果用户再次select该项目，那么它被删除。

任何帮助将不胜感激。

Answer 1

尝试这个：

 Private Sub Worksheet_Change(ByVal Target As Range) Const SEP As String = ", " Dim rngDV As Range Dim oldVal As String Dim newVal As String Dim arr, m, v If Target.Count > 1 Then GoTo exitHandler On Error Resume Next Set rngDV = Target.SpecialCells(xlCellTypeSameValidation) On Error GoTo exitHandler If rngDV Is Nothing Then Exit Sub newVal = Target.Value If Len(newVal) = 0 Then Exit Sub 'user has cleared the cell... Application.EnableEvents = False Application.Undo oldVal = Target.Value If oldVal <> "" Then arr = Split(oldVal, SEP) m = Application.Match(newVal, arr, 0) If IsError(m) Then newVal = oldVal & SEP & newVal Else arr(m - 1) = "" newVal = "" For Each v In arr If Len(v) > 0 Then newVal = newVal & IIf(Len(newVal) > 0, SEP, "") & v Next v End If Target.Value = newVal End If exitHandler: Application.EnableEvents = True End Sub