【问题标题】:Excel - Multiple selection drop down list - no duplication of selectionExcel - 多选下拉列表 - 没有重复选择
【发布时间】:2016-01-27 16:43:44
【问题描述】:

我在我的 excel 电子表格上开发了可以使用以下代码在下拉列表中选择多个项目:

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

但是,我现在想验证下拉列表项只能选择一次的答案。并且最好是,如果用户再次选择该项目,则将其删除。

任何帮助将不胜感激。

【问题讨论】:

    标签: excel vba dropdown


    【解决方案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
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2015-04-07
      • 2018-04-24
      • 1970-01-01
      • 1970-01-01
      • 2017-01-14
      • 1970-01-01
      相关资源
      最近更新 更多