VBA 清除下拉列表中的内容答案

【问题标题】：VBA Clear Contents in Drop Down ListVBA 清除下拉列表中的内容
【发布时间】：2016-12-16 16:20:49
【问题描述】：

我创建了一个下拉列表，每次您从下拉列表中选择新内容时，它都会添加到单元格中已有的内容中。问题，我是否正在尝试找到一种方法来清除它，并且我认为我的订购错误。代码如下：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler

On Error Resume Next
Set rngDV = Worksheets("Contact Log").Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI")

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 oldVal = "" Then
    'do nothing
  Else
    If newVal = "" Then
      'do nothing
    Else
      lUsed = InStr(1, oldVal, newVal)
      If lUsed > 0 Then
        If newVal = "CLEAR" Then
          Selection.ClearContents
        ElseIf Right(oldVal, Len(newVal)) = newVal Then
          Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
        Else
           Target.Value = Replace(oldVal, newVal & ", ", "")
        End If
      Else
        Target.Value = oldVal & ", " & newVal
      End If
    End If
  End If
End If

exitHandler:
  Application.EnableEvents = True
End Sub

我遇到的问题是，有时，如果我从下拉菜单中选择清除，它会将其添加到列表中，而不是清除单元格的内容。发生这种情况时，再次选择清除将成功清除单元格内容。

希望这是有道理的，如果您需要我澄清一下。是否因为我的 If 语句的顺序错误而发生此问题？

感谢您抽出宝贵时间！祝你有美好的一天！

【问题讨论】：

标签： excel vba dropdown

【解决方案1】：

在复制到单元格之前清除内容：

    If oldVal = "" Then
      'do nothing
      Else
      If newVal = "" Then
      'do nothing
      Else
        If newVal = "CLEAR" Then
          Selection.ClearContents
          GoTo exitHandler
        end if
        .....

【讨论】：

【解决方案2】：

您第一次输入“CLEAR”时，lUsed 为 0，因为您在 old 值中没有该字符串，因此您没有通过 If lUsed > 0 Then 检查，因此不到达If newVal = "CLEAR" Then支票

所以你必须把``If newVal = "CLEAR"check before theIf lUsed > 0 Then` 一个

就像对代码的这个小重构：

Option Explicit

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

    Set rngDV = Intersect(UsedRange, Range("AE:AE,AI:AI,AM:AM,AQ:AQ,AU:AU,AY:AY,BC:BC,BG:BG,BK:BK,BO:BO,BS:BS,BW:BW,CA:CA,CE:CE,CI:CI"))

    If Intersect(Target, rngDV) Is Nothing Then Exit Sub

    Application.EnableEvents = False
    On Error GoTo exitHandler

    newVal = Target.Value
    Select Case UCase(newVal)
        Case "CLEAR"
            Target.ClearContents

        Case vbNullString
            'do nothing

        Case Else
            Application.Undo
            oldVal = Target.Value
            If oldVal <> "" Then
                If InStr(1, oldVal, newVal) > 0 Then
                    If Right(oldVal, Len(newVal)) = newVal Then
                        Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
                    Else
                        Target.Value = Replace(oldVal, newVal & ", ", "")
                    End If
                Else
                    Target.Value = oldVal & ", " & newVal
                End If
            End If

        End Select

exitHandler:
    Application.EnableEvents = True
End Sub

还有一个弱点，在On Error GoTo exitHandler 语句之后可能引发的每个错误都会导致您结束子。

虽然您可能想处理Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2) 引发的错误，当输入选择第二个值时，他选择的值与第一个相同

【讨论】：