下拉列表中的VBA清除内容

我创build了一个下拉列表，每次从下拉列表中select新的内容时，它将添加到已经在单元格中的内容中。 问题是，我正试图find一种方法来清除它，我想我的订购是错误的。 代码如下：

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 

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

希望这是有道理的，如果你需要我，我会澄清。 这个问题发生是因为我的If语句的sorting是错误的吗？

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

Answer 1

你第一次input“CLEAR”， lUsed是0，因为你没有那个string在旧值，所以你不通过If lUsed > 0 Then检查，因此没有达到If newVal = "CLEAR" Then检查

所以你必须把`如果newVal =“CLEAR” check before the If lUsed> 0 Then` check before the

就像在你的代码的这个小重构中一样：

 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语句之后，每个错误都可能引发你结束这个sub。

同时也许你想要处理由Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)当inputselect作为第二个值时，他select了第一个

Answer 2

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

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