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

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

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

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

Answer 1

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

editTextView.setLongClickable(false);
editTextView.setTextIsSelectable(false);

Answer 2

您第一次输入＆＃34; CLEAR＆＃34;，lUsed为0，因为您在旧值中没有该字符串，因此您不会在＆＃39;通过If lUsed > 0 Then检查，因此无法进入If newVal = "CLEAR" Then支票

所以你必须把``如果newVal =＆＃34; CLEAR＆＃34; check before the如果lUsed＆gt; 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语句之后可能引发的每个错误都会导致你结束sub。

虽然当输入选择第二个值时，你可能想要处理由Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)引起的错误

下拉列表中的VBA清除内容

2 个答案: