VBA Очистить содержимое в раскрывающемся списке

Question

Я создал раскрывающийся список, где каждый раз, когда вы выбираете что-то новое из раскрывающегося списка, оно добавляется к тому, что уже находится в ячейке. Проблема, я пытаюсь найти способ ее очистить, и я думаю, что у меня неправильный порядок. Вот код:

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 неверно?

Спасибо, что нашли время! Хорошего дня!

Answer 1

первый раз, когда вы вводите «CLEAR», lUsed является 0, потому что не имел эту строку в старой значения так что вы не» т пройти If lUsed > 0 Then проверку и, таким образом, не достигают If newVal = "CLEAR" Then

Регулярно проверяйте

так что вы должны поместить `` Если newVal = «CLEAR» check before the Если lUsed> 0 затем` один

, как в этом небольшом рефакторинга кода:

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), когда вход выбирает как второе значение, которое он выбрал первым

Answer 2

Очистить содержимое перед копированием в ячейке:

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